Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
−9
{получить I}
function getSafeItoDBID(TEmployer e):Integer;
begin
if (e<>nil) and (e.getIdentificator()<>nil) and (e.getIdentificator().getID()<>nil) and (e.getIdentificator().getID().getID()<>nil)
then result:= e.getIdentificator().getID().getID().getValue().i;
else result:= 0;
end;Получить без ERROR ID для записи в MySQL
AlCodel,
07 Сентября 2017
0
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, LabeledMemo, math;
type
TForm1 = class(TForm)
Button1: TButton;
Aproxyes: TLabeledMemo;
Socks4: TLabeledMemo;
Socks5: TLabeledMemo;
OutMem: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
I,J,K:integer;
S:string;
TableHeader:string;
TableBody:string;
TableEnd:string;
iMax, iMax2:Integer;
List1, List2, List3:tstringlist;
Count1, Count2, Count3:Integer;
begin
List1:=tstringlist.Create;
list2:=tstringlist.Create;
list3:=tstringlist.Create;
Count1:=AProxyes.Lines.Count;
Count2:=SOCKS4.Lines.Count;
Count3:=Socks5.Lines.Count;
List1.Assign(AProxyes.Lines);
List2.Assign(SOCKS4.Lines);
List3.Assign(SOCKS5.Lines);
while (List1.Count <List2.Count) or (List1.Count <List3.Count) do
List1.Add('');
while (List2.Count <List1.Count) or (List2.Count <List3.Count) do
List2.Add('');
while (List3.Count <List1.Count) or (List3.Count <List2.Count) do
List3.Add('');
TableBody:='';
TableHeader:='<table border="1" cellspacing="1" cellpadding="1" style="width: 410px;">'#13#10' <tbody>'#13#10+
' <caption>'#13#10+' <p style="padding:5px"><b>Àíîíèìíûå è ýëèòíûå ïðîêñè (Îáíîâëåíèå îò 27.08.2017)</b><br /><br />Ïðîêñè áûëè ïðîâåðåíû íà àíîíèìíîñòü íàøèì <a href="http://freesoft.do.am/load/1-1-0-16" target="_blank"><b>ïðîêñè-÷åêåðîì</b></a></p>'#13#10' </caption>';
TableEnd:=' </tbody>'#13#10'</table>';
OutMem.Clear;
OutMem.Lines.Add(TableHeader);
OutMem.Lines.Add(' <tr>');
OutMem.Lines.Add(Format(' <td><b>Àíîíèìíûå (%d)</b></td>',[Count1]));
OutMem.Lines.Add(Format(' <td><b>Socks4 (%d)</b></td>',[Count2]));
OutMem.Lines.Add(Format(' <td><b>Socks5 (%d)</b></td>',[Count3]));
OutMem.Lines.Add(' </tr>');
for I:=0 to List1.Count -1 do
begin
OutMem.Lines.Add(' <tr>');
OutMem.Lines.Add(Format(' <td>%s</td>',[List1[I]]));
OutMem.Lines.Add(Format(' <td>%s</td>',[List2[I]]));
OutMem.Lines.Add(Format(' <td>%s</td>',[List3[I]]));
OutMem.Lines.Add(' </tr>');
end;
OutMem.Lines.Add(TableEnd);
end;
Рисует таблицу, как здесь: http://freesoft.do.am/index/0-13
Наклепал чтобы облегчить себе труд, в итоге уже не могу с нее слезть, а доделать некогда...
doctor_stertor,
02 Сентября 2017
+2
@ Martin Harvey
unit PrimeThread;
interface
uses
Classes;
type
TPrimeThrd = class(TThread)
private
FTestNumber: integer;
protected
function IsPrime: boolean;
procedure Execute; override;
public
property TestNumber: integer write FTestNumber;
end;
implementation
uses SysUtils, Dialogs;
function TPrimeThrd.IsPrime: boolean;
var
iter: integer;
begin
result := true;
if FTestNumber < 0 then
begin
result := false;
exit;
end;
if FTestNumber <= 2 then
exit;
for iter := 2 to FTestNumber - 1 do
begin
if (FTestNumber mod iter) = 0 then
begin
result := false;
{exit;}
end;
end;
end;
procedure TPrimeThrd.Execute;
begin
if IsPrime then
ShowMessage(IntToStr(FTestNumber) + 'is prime.')
else
ShowMessage(IntToStr(FTestNumber) + 'is not prime.');
end;
end.Харви умеет в потоки, но не умеет в делфи.
doctor_stertor,
29 Августа 2017
+2
procedure TMyThread.Execute;
begin
while True do
if MyThread.Teminated then break;
end;
Этот код выполняет бесконечный цикл. Однако, при выполнении в основной программе оператора
MyThread.Terminate;
цикл завершается, и поток прекращает свою работу.http://www.delphi-manual.ru/threads.php
doctor_stertor,
29 Августа 2017
0
procedure TMainForm.SelfKillTimerTimer(Sender: TObject);
begin
TTimer(Sender).Enabled:=False;
if MessageBox(Handle, PChar('Процесс закрытия приложения затянулся; вы хотите завершить его принудительно??'), PChar('Внимание'), MB_YESNO or MB_ICONQUESTION)= ID_YES then
Suicide;
end;
procedure TMainForm.Suicide;
var
hProc:THandle;
begin
hProc:=OpenProcess(PROCESS_TERMINATE, False, GetCurrentProcessID);
try
TerminateProcess(hProc, 1);
finally
CloseHandle(hProc); // R.I.P.
end;
end;...
doctor_stertor,
27 Августа 2017
−1
TServerThread = class(TThread)
private
procedure DoReadData;
protected
ThreadOwner: TIPCServer;
procedure Execute; override;
constructor Create(AThreadOwner: TIPCServer);
destructor Destroy; override;
public
end;Мы кодили, кодили и наконец накодили!
antipattern,
27 Июня 2017
0
procedure TForm1.ProcListAdvancedCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
var
TP:TprocessInfo;
xColor: TColor;
xRect: TRect;
xBitmap: TBitmap;
I, L, R: Integer;
begin
DefaultDraw:=False;
TP:=TProcessInfo(Item.SubItems.Objects[0]);
if (Item.Selected) then
begin
if Sender.Focused then
begin
if (FItemAtCursor <> -1) and (Item.Index = FItemAtCursor) then
xColor:=clNavy
else
xColor:=$00C56A31;
end
else
xColor:=$00D8E9EC
end
else
begin
if (TP.New<2) or (TP.Terminated<2) or (TP.Hidden) then
begin
if ShowDangerousProcesses then
if TP.Hidden then
xColor:=$00DBDBDB;
if ShowNewProcesses then
if TP.New <2 then
xColor:=$001DEB2D;
if ShowTerminatedProcesses then
if TP.Terminated < 2 then
xColor:=$001D2DEB;
end
else
if (Item.Index mod 2 = 1) then
xColor:=RGB(245,245,255)
else
xColor:=clWindow;
end;
Sender.Canvas.Brush.Color:=xColor;
DefaultDraw:=True;
if (Item.Selected) and Sender.Focused
then Sender.Canvas.Font.Color:=clWindow
else Sender.Canvas.Font.Color:=clWindowText;
Sender.Canvas.FillRect(Item.DisplayRect(drLabel));
DefaultDraw:=True;
Exit;
xRect:=Item.DisplayRect(drLabel);
Sender.Canvas.TextRect(xRect,xRect.Left+2,xRect.Top,Item.Caption);
for I:=0 to TListView(Sender).Columns.Count-1 do
begin
if TListView(Sender).Columns[TListView(Sender).Columns[I].ID].Width<=0 then Continue;
if (I=0) and (TListView(Sender).Columns[I].ID <> 0) then
begin
xRect.Left:=0;
xRect.Right:=xRect.Left+TListView(Sender).Columns.Items[TListView(Sender).Columns[I].ID].Width-1;
Sender.Canvas.FillRect(xRect);
Sender.Canvas.TextRect(xRect,xRect.Left+2,xRect.Top,Item.SubItems[TListView(Sender).Columns[I].ID-1]);
end
else
begin
if I>0 then
begin
xRect.Left:=xRect.Right+1;
xRect.Right:=xRect.Left+TListView(Sender).Columns.Items[TListView(Sender).Columns[I].ID].Width-1;
Sender.Canvas.FillRect(xRect);
if TListView(Sender).Columns[I].ID >0 then
Sender.Canvas.TextRect(xRect,xRect.Left+5,xRect.Top,Item.SubItems[Pred(TListView(Sender).Columns[I].ID)])
else
begin
L:=(Item.DisplayRect(drIcon).Right-Item.DisplayRect(drIcon).Left)+6;
Sender.Canvas.TextRect(xRect,xRect.Left+L,xRect.Top, Item.Caption)
end;
end;
end;
end;
Sender.Canvas.Brush.Color:=clWindow;
Sender.Canvas.FillRect(Item.DisplayRect(drIcon));
if Item.ImageIndex=-1 then Exit;
xBitmap:=TBitmap.Create;
TListView(Sender).SmallImages.GetBitmap(Item.ImageIndex,xBitmap);
ListView - великий и ужасный! - в режиме OwnerDraw.
Писал диспетчер процессов. Когда я разрешил прятать столбцы и включил свойство FullDrag, моя жизнь круто изменилась.
antipattern,
19 Июня 2017
−1
(багрепорт)
http://www.alphaskins.com/forum/index.php?app=core&module=attach§ion=attach&attach_rel_module=post&attach_id=8330Сергох Гончаров с AlphaSkins.com шалит )Сергох Гончаров с AlphaSkins.com шалит )
antipattern,
06 Июня 2017
0
function IsExecutablePacked(FileName: WideString): Boolean;
var
i: Cardinal;
CompressionRatio: Double;
Count: Cardinal;
MathX: array [0 .. 255] of Integer;
FileStream: TFileStream;
Buffer: PAnsiChar;
FileHandle: THandle;
begin
Result := False;
try
FileHandle := 0;
FileHandle := CreateFileW(PWideChar(FileName), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_DELETE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if (FileHandle <> 0) and FileExists(FileName) then
begin
try
FileStream := TFileStream.Create(FileHandle);
Count := FileStream.Seek(0, soFromEnd);
try
GetMem(Buffer, Count);
FileStream.Seek(0, soFromBeginning);
FileStream.Read(Buffer^, Count);
CompressionRatio := 0;
FillChar(MathX, Sizeof(MathX), 0);
for i := 0 to Count - 1 do
Inc(MathX[Windows.PByte(DWORD(Buffer) + (i))^]);
for i := 0 to 255 do
if MathX > 0 then
CompressionRatio := CompressionRatio - Log2(MathX / Count) * MathX;
finally
FreeMem(Buffer, Count);
end;
CompressionRatio := (Count * 8) / CompressionRatio;
CompressionRatio := 100 / CompressionRatio;
if CompressionRatio > 97 then
Result := True;
finally
FileStream.Free;
end;
end;
finally
end;
end;"Ис Эксекутабле Пуцкед" - форматирование сохранено.
antipattern,
04 Июня 2017
−1413
function Unescape(const s: AnsiString): widestring;
var
i: Integer;
j: Integer;
c: Integer;
begin
// Make result at least large enough. This prevents too many reallocs
SetLength(Result, Length(s));
i := 1;
j := 1;
while i <= Length(s) do begin
if s[i] = '\' then begin
if i < Length(s) then begin
// escaped backslash?
if s[i + 1] = '\' then begin
Result[j] := '\';
inc(i, 2);
end
// convert hex number to WideChar
else if (s[i + 1] = 'u') and (i + 1 + 4 <= Length(s))
and TryStrToInt('$' + string(Copy(s, i + 2, 4)), c) then begin
inc(i, 6);
Result[j] := WideChar(c);
end else begin
raise Exception.CreateFmt('Invalid code at position %d', [i]);
end;
end else begin
raise Exception.Create('Unexpected end of string');
end;
end else begin
Result[j] := WideChar(s[i]);
inc(i);
end;
inc(j);
end;
// Trim result in case we reserved too much space
SetLength(Result, j - 1);
end;Это не вирус. Просто в Delphi 7 не завезли JSon.
doctor_stertor,
07 Мая 2017
Follow us!