Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
Всего: 23
+133
if chkyandex.Checked then
reg.Expression:='([a-zA-Z0-9]+[\.]{0,}[\_]{0,}[-]{0,})+@([ya]{2}[ndex]{0,4}|[xaker]{5})\.[a-zA-Z]{2,3}\s{0,4}[:;]\s{0,4}[a-zA-Z0-9\.\_]+';
else
reg.Expression:='([a-zA-Z0-9]+[\.]{0,}[\_]{0,}[-]{0,})+@([mail]{4}|[inbox]{5}|bk{2}|list{4})\.([a-zA-Z]{2,3}\s{0,4}[:;]\s{0,4}[_\-a-zA-Z\d\.\_]+)';
RegEXP головного мозга.
Работает.
brutushafens,
08 Июля 2014
+144
----
brutushafens,
03 Июля 2014
+96
procedure TRegistry.GetKeyNames(Strings: TStrings);
var
Len: DWORD;
I: Integer;
Info: TRegKeyInfo;
S: string;
begin
Strings.Clear; // Очистить список перед добавлением. Это пиздец, как важно!!! Программист не додумается сам очистить список.
if GetKeyInfo(Info) then
begin
SetString(S, nil, Info.MaxSubKeyLen + 1);
for I := 0 to Info.NumSubKeys - 1 do
begin
Len := Info.MaxSubKeyLen + 1;
RegEnumKeyEx(CurrentKey, I, PChar(S), Len, nil, nil, nil, nil);
Strings.Add(PChar(S));
end;
end;
end;
Из registry.pas (Delphi 2009)
Все регистровые функции зашкварены этим, не знаю, как в семерке; это значит, что в цикле их без дерьма не поюзаешь.
Очень обидно.
brutushafens,
26 Июня 2014
−130
Привет всем, помогите решить проблему.
reached limit: cannot create any more controls for this from
Как я понял, число контроллеров не должно превышать 255-256 в одной форме. Как этого избежать?
Можно ли вообще создавать формы с общими переменными? Спасибоhttp://vbbook.ru/visual-basic/vvedenie-visual-basic/
brutushafens,
24 Июня 2014
+86
function IsMemoryCommitByAdress(const AAddress: Pointer): Boolean;
var
MemoryInfo: TMemoryBasicInformation;
begin
Result := False;
if not Assigned(AAddress) then
Exit;
VirtualQuery(AAddress, MemoryInfo, SizeOf(MemoryInfo));
Result := MemoryInfo.State and MEM_COMMIT <> 0;
end;
function IsPointerToVMT(const APointer: Pointer): Boolean;
var
VMTPointer, VMTPointerSelf: Pointer;
begin
Result := False;
if not IsMemoryCommitByAdress(APointer) then
Exit;
VMTPointer := APointer;
VMTPointerSelf := Pointer(Integer(VMTPointer) + vmtSelfPtr);
if not IsMemoryCommitByAdress(VMTPointer) then
Exit;
if not IsMemoryCommitByAdress(VMTPointerSelf) then
Exit;
if not IsMemoryCommitByAdress(PPointer(VMTPointerSelf)^) then
Exit;
Result := PPointer(VMTPointerSelf)^ = VMTPointer;
end;
function IsBadptr(apointer:pointer):boolean;
begin
Result := IsMemoryCommitByAdress(APointer) and IsPointerToVMT(PPointer(APointer)^);
end;
Функция, для определения качества указателя, в ситуации "один объект - несколько указателей".
Гк в том, что нет надежности - это все равно, что юзать IsBadReadPtr и аналогичные.
Почему-то никто не пытается использовать операторы is и as (я узнал о них благодаря Тарасу, спасибо ему), чтобы сравнить качество приведения.
brutushafens,
19 Июня 2014
+92
type
TForm1 = class(TForm)
Button1: TButton;
Button3: TButton;
ListBox1: TListBox;
Button2: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TListThread = class(TThread)
protected
procedure Execute; override;
end;
TMyThread = class(TThread)
protected
procedure Execute; override;
end;
TYouThread = class(TThread)
protected
procedure Execute; override;
end;
var
Form1: TForm1;
threadList1: TThreadList;
mythreadRunning, youthreadRunning, listThreadRunning: Boolean;
globalCount: Integer;
listProcess: TListThread; { TListThread is a custom descendant of TThread. }
secondProcess: TMyThread; { TMyThread is a custom descendant of TThread. }
otherSecondProcess: TYouThread; { TMyThread is a custom descendant of TThread. }
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if (mythreadRunning = FALSE) then
begin
mythreadRunning:= TRUE;
secondProcess := TMyThread.Create(True); { Create suspended--secondProcess does not run yet. }
secondProcess.FreeOnTerminate := True; { You do not need to clean up after termination. }
secondProcess.Priority := tpLower; // Set the priority to lower than normal.
secondProcess.Resume; { Now run the thread. }
end
else
MessageDlg('This thread is still running. You are going to hurt yourself!',
mtInformation, [mbOk], 0);
end;
procedure TMyThread.Execute;
var
I: Integer;
myRadio: TRadioButton;
begin
for I := 0 to 20 do
begin
if (Terminated) then
begin
mythreadRunning:= FALSE;
exit;
end;
myRadio:= TRadioButton.Create(Form1);
globalCount:= globalCount + 1;
myRadio.Name:= 'RadioButton' + IntToStr(globalCount);
threadList1.Add(myRadio);
Sleep(1000);
end;
mythreadRunning:= FALSE;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if (listthreadRunning = FALSE) then
begin
listThreadRunning:= TRUE;
listProcess := TListThread.Create(True); { Create suspended--secondProcess does not run yet. }
listProcess.FreeOnTerminate := True; { You do not need to clean up after termination. }
listProcess.Priority := tpLower; // Set the priority to lower than normal.
listProcess.Resume; { Now run the thread. }
end;
end;
procedure TListThread.Execute;
var
I: Integer;
Temp: TControl;
myList: TList;
begin
while(True) do
begin
http://docwiki.embarcadero.com/CodeExamples/XE5/en/TThreadList_%28Delphi%29
Беда, когда примеры пишут психически неполноценные люди. Самое ужасное то, что этот "пример" висит на сайте embarcadero.
brutushafens,
17 Июня 2014
+84
type
TSearchF = class(TThread)
private
protected
procedure Execute; override;
public
Str: String; // думаю назначение обоих
Pause: Boolean; // параметров объяснять не надо
end;
и
Код:
procedure TSearchF.Execute;
begin
while not Terminated do
begin
if(Pause) then
begin
Sleep(10);
end else
begin
FindFile(Str);
end;
end;
end;
http://www.programmersforum.ru/showthread.php?t=91543
Без комментариев.
brutushafens,
17 Июня 2014
+98
procedure TForm1.FormCreate(Sender: TObject);
var
H: THandle;
R: TRect;
appbardata: tappbardata;
begin
sx := 0;
sy := 0;
ax := 0;
ay := 0;
sh := GetSystemMetrics(SM_CYSCREEN);
ZeroMemory(@appbardata, SizeOf(tappbardata));
SHAppbarmessage(5, appbardata);
If appbardata.rc.TopLeft.X > 1 then
begin
ax := appbardata.rc.BottomRight.X - appbardata.rc.TopLeft.X;
ax:=ax+4;
end
else
ax:=6;
If appbardata.rc.TopLeft.y > 1 then
begin
ay := appbardata.rc.BottomRight.y - appbardata.rc.TopLeft.y;
ay:=ay+4;
end
else
ay:=6;
sx := (GetSystemMetrics(SM_CXSCREEN)-form1.ClientWidth-ax);
sy := (GetSystemMetrics(SM_CYSCREEN)-form1.ClientHeight-ay);
Form1.left := sx;
Form1.Top :=sy;
end;
Выравнивание всплывающего окошка точно по правому краю.
Даже не знаю, гк ли это, ибо глаз не видит себя. Но смотрится очень странно, почти как хак.
brutushafens,
10 Июня 2014
−123
function GetRaz()
Open "C:NeWFiles.txt" For Output As #1
Print #1, "0"
Close
Shell "cmd /X /C set PROCESSOR_ARCHITECTURE > C:NeWFiles.txt", vbHide
1
Open "C:NeWFiles.txt" For Input As #1
Do While Not EOF(1)
Input #1, Items
Loop
Close
If Items = "" Or items = "0" Then GoTo 1
GetRaz = Replace(Items, "PROCESSOR_ARCHITECTURE=", "")
End function
"Получаем разрядность Windows"
http://vbbook.ru/1401972927/
brutushafens,
04 Июня 2014
+83
var
ABuffer: PAnsiChar;
AText: PAnsiChar;
BBuffer: PAnsiChar;
begin
ABuffer := 'TEST';
BinToHex(ABuffer, AText, Length(ABuffer));
ShowMessage(AText);
ShowMessage(IntToStr(Length(AText)));
GetMem(BBuffer, Length(AText) div 2);
HexToBin(AText, BBuffer, Length(AText) div 2);
BBuffer[Length(BBuffer) - 1] := #0;
ShowMessage(IntToStr(SizeOf(BBuffer)));
ShowMessage(BBuffer);
FreeMem(BBuffer);
end;
http://www.sql.ru/forum/653685/bintohex-i-hextobin-delphi2009
Возможно, я ошибаюсь, но по-моему код - лажа; насколько я понимаю, указатель "AText: PAnsiChar;" всего лишь УКАЗАТЕЛЬ, под него нигде в коде не выделяется память, автор юзает его как простую переменную.
И никто его не поправил. Вроде думающие люди.
brutushafens,
25 Мая 2014
Follow us!