Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
Всего: 9
−44
procedure TMyThread.Execute;
begin
while True do
if MyThread.Teminated then break;
end;
Этот код выполняет бесконечный цикл. Однако, при выполнении в основной программе оператора
MyThread.Terminate;
цикл завершается, и поток прекращает свою работу.Отсюда: http://www.delphi-manual.ru/threads.php
rotretS,
09 Марта 2017
−13
{Автор Зорков Игорь - [email protected]}
procedure TForm1.RefreshInfo;
var
i, ProcessCount: Integer;
Processes: TProcesses;
CPU, CPUIdle: Extended;
begin
TickCountOld:= GetTickCount - TickCount;
TickCount:= GetTickCount;
ProcessCount:= GetProcesses(Processes);
NewPIDList.Clear;
for i:= 0 to ProcessCount - 1 do
NewPIDList.Add(IntToStr(Processes[i].PID));
if (NewPIDList.Text <> PIDList.Text) then
begin
if NewPIDList.Count > 0 then
begin
for i:= 0 to NewPIDList.Count - 1 do
begin
if PIDList.IndexOf(NewPIDList.Strings[i]) = -1 then
begin
SetLength(ProcessInfo, Length(ProcessInfo) + 1);
ProcessInfo[ProcessInfoList.Count]:= TProcessInfo.Create;
ProcessInfo[ProcessInfoList.Count].Process:= Processes[i].Process;
ProcessInfo[ProcessInfoList.Count].PID:= Processes[i].PID;
CPU:= Int64(Processes[i].KernelTime.dwLowDateTime or (Processes[i].KernelTime.dwHighDateTime shr 32)) + Int64(Processes[i].UserTime.dwLowDateTime or (Processes[i].UserTime.dwHighDateTime shr 32));
ProcessInfo[ProcessInfoList.Count].CPU:= CPU;
ProcessInfo[ProcessInfoList.Count].CPUDelta:= CPU;
if bRefreshFirstTime then
ProcessInfo[ProcessInfoList.Count].New:= 2
else
ProcessInfo[ProcessInfoList.Count].New:= 0;
ProcessInfo[ProcessInfoList.Count].Terminated:= 20;
ProcessInfoList.AddObject(NewPIDList.Strings[i], ProcessInfo[ProcessInfoList.Count]);
end;
end;
end;
if PIDList.Count > 0 then
begin
for i:= 0 to PIDList.Count - 1 do
begin
if NewPIDList.IndexOf(PIDList.Strings[i]) = -1 then
begin
if ProcessInfoList.IndexOf(PIDList.Strings[i]) <> -1 then
begin
if (ProcessInfoList.Objects[ProcessInfoList.IndexOf(PIDList.Strings[i])] as TProcessInfo).Terminated = 20 then
(ProcessInfoList.Objects[ProcessInfoList.IndexOf(PIDList.Strings[i])] as TProcessInfo).Terminated:= 0;
end;
end;
end;
end;
PIDList.Assign(NewPIDList);
end;
CPUIdle:= 0;
for i:= 0 to ProcessCount - 1 do
begin
CPU:= Int64(Processes[i].KernelTime.dwLowDateTime or (Processes[i].KernelTime.dwHighDateTime)) + Int64(Processes[i].UserTime.dwLowDateTime or (Processes[i].UserTime.dwHighDateTime));
(ProcessInfoList.Objects[ProcessInfoList.IndexOf(IntToStr(Processes[i].PID))] as TProcessInfo).CPUDelta:= CPU - (ProcessInfoList.Objects[ProcessInfoList.IndexOf(IntToStr(Processes[i].PID))] as TProcessInfo).CPU;
(ProcessInfoList.Objects[ProcessInfoList.IndexOf(IntToStr(Processes[i].PID))] as TProcessInfo).CPU:= CPU;
if Processes[i].PID <> 0 then
CPUIdle:= CPUIdle + (ProcessInfoList.Objects[ProcessInfoList.IndexOf(IntToStr(Processes[i].PID))] as TProcessInfo).CPUDelta;
end;
if CPUIdle > 0 then
(ProcessInfoList.Objects[ProcessInfoList.IndexOf('0')] as TProcessInfo).CPUDelta:= CPUIdle
else
(ProcessInfoList.Objects[ProcessInfoList.IndexOf('0')] as TProcessInfo).CPUDelta:= 100;
Зачем юзать переменные? Это, блять, грех. Бог покарает. Обратите внимание, как этот долбоёб приводит типы, и сколько раз обращается к объекту по его индексу.
Автор, возьми меч из папье-маше и отсеки себе руки по локоть. По локоть, блядь!..
rotretS,
16 Февраля 2017
−50
lst:=proclist.Selected;
if assigned(lst) then
begin
tp:=tmyproc(lst.SubItems.Objects[0]);
S:=tp.exename;
P:=tp.PID;
end
else
begin
S:='';
P:=0;
end;
ID:=-1;
proclist.Items.BeginUpdate;
try
//////////////////////////////////////////////////////////
if prlist.Count > 0 then
while proclist.Items.Count > prlist.Count do
begin
lst:=proclist.Items[proclist.Items.Count-1];
lst.Delete;
end;
while proclist.Items.Count < prlist.Count do
with proclist.Items.Add do
begin
caption:='';
subitems.Add('');
subitems.add('');
subitems.add('');
subitems.add('');
subitems.add('');
subitems.add('');
end;
/////////////////////////////////////////////////////////
for i:=0 to prlist.Count -1 do
begin
tp:=(prlist.Objects[i] as tmyproc);
with proclist.items[i] do
begin
if tp.isHidden then
begin
Inc(HidProcs);
ImageIndex:=8;
end
else
ImageIndex:=7;
if (s <> emptystr) and (p=tp.pid) and (s=tp.exename) then
ID:=Index;
Caption:=tp.ExeName;
with Subitems do
begin
Objects[0].Free;
Objects[0]:=tp;
Strings[0]:=tp.ModulePath;
end;
subitems.Strings[1]:=IntToStr(tp.PID);Ваш ListView всё ещё съезжает при обновлении? Тогда мы идём к Вам.
rotretS,
15 Января 2017
−43
#include <windows.h>
#include <stdio.h>
HANDLE hSlot;
LPTSTR Slot = TEXT("\\\\.\\mailslot\\sample_mailslot");
BOOL WINAPI MakeSlot(LPTSTR lpszSlotName)
{
hSlot = CreateMailslot(lpszSlotName,
0, // no maximum message size
MAILSLOT_WAIT_FOREVER, // no time-out for operations
(LPSECURITY_ATTRIBUTES) NULL); // default security
if (hSlot == INVALID_HANDLE_VALUE)
{
printf("CreateMailslot failed with %d\n", GetLastError());
return FALSE;
}
else printf("Mailslot created successfully.\n");
return TRUE;
}
void main()
{
MakeSlot(Slot);
}
@LPTSTR Slot = TEXT("\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\.\\mailslot\\sample_mailslot");
Больше слэшэй богу слэшэй!..
"С++" - убожество.
rotretS,
05 Января 2017
−107
function FindTask(run:boolean=false):boolean;
var
TaskService: ITaskService;
Folder: ITaskFolder;
Tasks: IRegisteredTaskCollection;
Task: IRegisteredTask;
RTask:IRunningTask;
Action:IAction;
i: Integer;
Path:string;
begin
Result:=false;
OleCheck(CoInitialize(nil));
try
OleCheck(CoCreateInstance(CLSID_TaskScheduler, nil, CLSCTX_INPROC_SERVER, IID_ITaskService, TaskService));
OleCheck(TaskService.Connect(Null, Null, Null, Null));
OleCheck(TaskService.GetFolder('\', Folder));
OleCheck(Folder.GetTasks(0, Tasks));
if Tasks.Count > 0 then
begin
for I:=1 to Tasks.Count do
begin
Task:=Tasks.Item[i];
if Task <> nil then
begin
if WideSameText(Task.Name, AppTaskName) then
begin
if task.Definition.Actions.Count >0 then
begin
Action:=task.Definition.Actions.Item[1];
Path:=IExecAction(Action).Path;
Path:=StringReplace(Path,'"','',[rfReplaceAll]);
if not WideSameText(Path, ParamStr(0)) then
Break;
end
else
Exit;
if Run then
//begin
OleCheck(Task.Run(Null, RTask));
// try
// Sleep(3000);
// Rtask.Refresh;
// Result:=(rTask.State=TASK_STATE_RUNNING);
// except
// end;
// Exit;
//end
//else
//begin
Result:=true;
Break;
//end;
end;
Task:=nil;
end;
end;
end;
TaskService:=nil;
finally
TaskService:=nil;
Action:=nil;
Folder:=nil;
Tasks:=nil;
Task:=nil;
RTask:=nil;
CoUninitialize();
end;
end;
Олеблядство. Код на строке 45 кидает исключение "Ни один экземпляр задачи не запущен", ибо метод Run асинхронен.
Костыль на строке 43 призван предотвратить исключение.
Кто знает, как сделать правильно (дождаться запуска приложения)?
rotretS,
31 Декабря 2016
−66
function ColorToHTML(Color: TColor): string;
begin
{RGB составляющие цвета переводим в шестнадцатеричную
систему счисления}
FmtStr(Result,
'#%.2x%.2x%.2x',
[Lo(Color), {красный}
Lo(Color shr 8), {зелёный}
Lo((Color shr 8) shr 8) {синий}]);
end;Тро-Ло-ло-ло
rotretS,
03 Декабря 2016
−67
{ Delphi compatible }
{$IFNDEF PtrInt} type PtrInt = ^Integer; {$ENDIF}
{$IFNDEF PPointer} type PPointer = ^Pointer; {$ENDIF}
{$IFNDEF PPChar} type PPChar = ^PChar; {$ENDIF}
var
ls_lib: array[1..3] of luaL_reg =
(
(name: 'MultAllNumbers'; func: forLua_MultAllNumbers),
(name: 'GetHostAppPath'; func: forLua_GetHostAppPath),
(name: nil; func: nil)
);
function luaopen_SimpleDelphiLua(L: Plua_State): Integer; cdecl;
begin
luaL_openlib(L, PChar('SimpleDelphiLua'), @ls_lib, 0);
lua_pop(L, 1);
Result := 0;
end;
https://quik2dde.ru/viewtopic.php?id=40
Чел пишет на луе, и юзает дельфийские либы.
Обратите внимание, как он декларирует типы.
rotretS,
22 Ноября 2016
−70
unit HTML;
interface
uses
Windows, MSHTML, Registry, ActiveX, ComObj, Variants, SysUtils, dialogs;
type
THTMLPage=class
FDocument:IHTMLDocument2;
private
public
function Exec(const text:string):string;
constructor Create;
destructor Destroy; override;
end;
implementation
uses unit1;
var
ZoneValue:Integer=0;
procedure PrepareKey;
var
Reg:TRegistry;
begin
Reg:=TRegistry.Create;
try
Reg.RootKey:=HKEY_CURRENT_USER;
if Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3',false) then
try
ZoneValue:=Reg.ReadInteger('1A10');
Reg.WriteInteger('1A10',0);
finally
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
procedure RestoreKey;
var
Reg:TRegistry;
begin
Reg:=TRegistry.Create;
try
Reg.RootKey:=HKEY_CURRENT_USER;
if Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3',false) then
try
Reg.WriteInteger('1A10',ZoneValue);
finally
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
{ THTMLPage }
constructor THTMLPage.Create;
begin
FDocument:=coHTMLDocument.Create as IHTMLDocument2;
FDocument.clear;
end;
destructor THTMLPage.Destroy;
begin
inherited;
end;
function THTMLPage.Exec(const text: string): string;
var
Arr:OleVariant;
S:string;
begin
Result:='';
S:=text;
S:=StringReplace(S,'src','',[rfreplaceall, rfignorecase]);
S:=StringReplace(S,'href=','',[rfreplaceall, rfignorecase]);
Arr:=VarArrayCreate([0,0],VarVariant);
Arr[0]:= S;
FDocument:=CreateComObject(Class_HTMLDOcument) as IHTMLDocument2;
FDocument.Write(PSafeArray(System.TVarData(Arr).VArray));
FDocument.Close; // частично инициализированный
if Assigned(FDocument) then
Result:=FDocument.body.InnerText;
end;
initialization
PrepareKey;
finalization
RestoreKey;
end.Рыба для парсинга HTML (позволяет отработать скриптам в теле страницы)
rotretS,
06 Ноября 2016
−66
function RandomStr(Len:Integer; Opts:TRndSType=[rtUpperCase]):string;
var
I,D:Integer;
RS,RE, X:Integer;
S:string;
Tmp:string;
begin
Result:='';
I:=0;
S:='abcdefjhijklmnopqrstuvwxyzABCDEFJHIJKLMNOPQRSTUVWXYZ';
Randomize;
if rtLowerCase in Opts then
begin
RS:=1;
if not (rtUpperCase in Opts) then
RE:=27
else
RE:=53
end;
if rtUpperCase in Opts then
begin
if not (rtLowerCase in Opts) then
RS:=27;
RE:=53
end;
X:=Len*2;
while Length(Tmp) <> X do
begin
Randomize;
Tmp:=Tmp+S[RandomRange(RS,RE)];
end;
Inc(X);
if rtDigits in Opts then
begin
for I:=1 to Len do
Insert(IntToStr(RandomRange(0,10)),Tmp,RandomRange(1, X));
end;
Result:=Copy(Tmp,RandomRange(1,Len),Len);
end;
Владыка криптостойких паролей.
Код мой.
rotretS,
06 Ноября 2016
Follow us!