Видимо окно авторизации
Для работы нужен Firemonkey+Synapse
Код не смотрел даже, не интересно.
Код потока -
Кому не хочется качать исходник.*
GitHub - (спизжено мб)
Код:
function GetUseFromWindows: string;
var
UserName: string;
UserNameLen: Dword;
Begin
UserNameLen:= 255;
SetLength(UserName, UserNameLen);
if GetUserName(Pchar(UserName), UserNameLen) then
Result:= Copy(UserName, 1, UserNameLen - 1)
else
Result:= 'Unknown';
End;
function GetSerialNum: string;
var
SerialNum: Dword;
a, b: Dword;
Buffer: array[0..255] of char;
begin
Result:='';
try
GetVolumeInformation(Pchar('C:\'), Buffer,
Sizeof(Buffer), @SerialNum, a, b, nil, 0);
finally
Result:= IntToStr(SerialNum);
end;
end;
function GetComputerNetName: string;
var
Buffer: array[0..255] of char;
Size: Dword;
begin
Size:= 256;
if GetComputerName(Buffer, Size) then
Result := buffer
else
Result:= ''
end;
function StringToHex(str1,Separator:String):String;
var
buf: String;
i: Integer;
Begin
buf:= '';
for i:= 1 to Length(str1) do
begin
buf:= buf+IntToHex(Byte(str1[i]),2)+Separator;
end;
Result:= buf;
end;
function getSerial: string;
begin
Result:= StringToHex((GetUseFromWindows + GetSerialNum + GetComputerNetName), '');
end;
procedure TForm9.Button1Click(Sender: TObject);
var
Reg: TRegistry;
HTTP: THTTPSend;
HTML: TStringList;
begin
if form9.Edit1.Text = '' then
begin
ExitProcess(0);
end
else
begin
HTML:= TStringList.Create;
HTTP:= THTTPSend.Create;
HTTP.Protocol:= '1.1';
HTTP.Headers.Add('Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8');
HTTP.MimeType:= 'text/html';
HTTP.UserAgent:= 'Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/43.0.2357.130 Safari/537.36 OPR/30.0.1835.125';
if HTTP.HTTPMethod ('GET' , 'http://paypalauthapiga.usite.pro/License2/'+form9.Edit1.Text+'.csv') then
begin
HTML.LoadFromStream(HTTP.Document);
if Pos ((form9.Edit2.text), HTML.text) <> 0 then
begin
Reg:= TRegistry.Create;
Reg.RootKey:= HKEY_CURRENT_USER;
if not Reg.KeyExists('SoftWare\Lexi') then
begin
Reg.CreateKey('SoftWare\Lexi');
end;
Reg.OpenKey('SoftWare\Lexi', True);
Reg.WriteString('Skype', form9.Edit1.Text);
Reg.CloseKey;
FreeAndNil(Reg);
Form1.Show;
Form9.Hide;
end
else
begin
ExitProcess(0);
end;
FreeAndNil(HTML);
FreeAndNil(HTTP);
end;
end;
end;
procedure TForm9.FormCreate(Sender: TObject);
var
H: THandle;
HTTP: THTTPSend;
HTML: TStringList;
Reg: TRegistry;
begin
HTTP:= THTTPSend.Create;
HTML:= TStringList.Create;
FreeAndNil(HTML);
FreeAndNil(HTTP);
Reg:= TRegistry.Create;
Reg.RootKey:= HKEY_CURRENT_USER;
if Reg.KeyExists('SoftWare\ShopCoder') then
begin
Reg.OpenKeyReadOnly('SoftWare\ShopCoder');
form9.Edit1.Text:= Reg.ReadString('Skype');
Reg.CloseKey;
end;
FreeAndNil(Reg);
H:= CreateMutex(nil, True, 'nguYzrfp');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
ShowMessage('LOH');
ExitProcess(0);
end;
form9.Edit2.Text:= getSerial;
end;
Код не смотрел даже, не интересно.
Код потока -
Пожалуйста,
Вход
или
Регистрация
для просмотра содержимого URL-адресов!
Кому не хочется качать исходник.*
Для просмотра скрытого содержимого вы должны войти или зарегистрироваться.
GitHub - (спизжено мб)
Пожалуйста,
Вход
или
Регистрация
для просмотра содержимого URL-адресов!
Скрытое содержимое для пользователей: колебас
Последнее редактирование модератором: