-
Список говнокодов пользователя brutushafens
Всего: 23
-
+133
- 1
- 2
- 3
- 4
- 5
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
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
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
- 1
- 2
- 3
- 4
Привет всем, помогите решить проблему.
reached limit: cannot create any more controls for this from
Как я понял, число контроллеров не должно превышать 255-256 в одной форме. Как этого избежать?
Можно ли вообще создавать формы с общими переменными? Спасибо
http://vbbook.ru/visual-basic/vvedenie-visual-basic/
brutushafens,
24 Июня 2014
-
+86
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
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
- 001
- 002
- 003
- 004
- 005
- 006
- 007
- 008
- 009
- 010
- 011
- 012
- 013
- 014
- 015
- 016
- 017
- 018
- 019
- 020
- 021
- 022
- 023
- 024
- 025
- 026
- 027
- 028
- 029
- 030
- 031
- 032
- 033
- 034
- 035
- 036
- 037
- 038
- 039
- 040
- 041
- 042
- 043
- 044
- 045
- 046
- 047
- 048
- 049
- 050
- 051
- 052
- 053
- 054
- 055
- 056
- 057
- 058
- 059
- 060
- 061
- 062
- 063
- 064
- 065
- 066
- 067
- 068
- 069
- 070
- 071
- 072
- 073
- 074
- 075
- 076
- 077
- 078
- 079
- 080
- 081
- 082
- 083
- 084
- 085
- 086
- 087
- 088
- 089
- 090
- 091
- 092
- 093
- 094
- 095
- 096
- 097
- 098
- 099
- 100
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
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
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
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
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
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
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
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
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