BAHMANNN

Hi All Decrypt Full 100% Delphi Help For Convert To Vb --------------------------------------------------- unit MainUnit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Registry; type TMainForm = class(TForm) UsersCombo: TComboBox; Label3: TLabel; SerialLabel: TStaticText; EncPassLabel: TStaticText; DecPassLabel: TStaticText; procedure FormShow(Sender: TObject); procedure UsersComboChange(Sender: TObject); private { Private declarations } function GetVolumeSerial: string; function GivePassword(UserName, EncPass, VolumeSerial: string): string; public { Public declarations } end; var MainForm: TMainForm; implementation uses StrUtils; {$R *.dfm} procedure TMainForm.FormShow(Sender: TObject); var Reg: TRegistry; begin Reg := TRegistry.Create; if Reg.OpenKey('\Software\Paltalk',False) then begin Reg.GetKeyNames(UsersCombo.Items); if UsersCombo.Items.Count>0 then UsersCombo.ItemIndex := UsersCombo.Items.IndexOf(Reg.ReadString('cur_user')); Reg.CloseKey; end; Reg.Free; SerialLabel.Caption := GetVolumeSerial; UsersComboChange(Self); end; function TMainForm.GetVolumeSerial: string; var SerialNo: Cardinal; Tmp: Cardinal; begin GetVolumeInformation('C:\',nil,0,@SerialNo,Tmp,Tmp,nil,0); Result := IntToHex(SerialNo,8); end; procedure TMainForm.UsersComboChange(Sender: TObject); var Reg: TRegistry; begin Reg := TRegistry.Create; Reg.OpenKey('\Software\Paltalk\'+UsersCombo.Text,False); EncPassLabel.Caption := Reg.ReadString('pwd'); Reg.CloseKey; Reg.Free; DecPassLabel.Caption := GivePassword(UsersCombo.Text,EncPassLabel.Caption,SerialLabel.Caption); end; function TMainForm.GivePassword(UserName, EncPass, VolumeSerial: string): string; var i,j,k: Integer; MixedUserSerial: string; begin while (Length(UserName)+Length(VolumeSerial)>0) do begin if Length(UserName)>0 then begin MixedUserSerial := MixedUserSerial + LeftStr(UserName,1); Delete(UserName,1,1); end; if Length(VolumeSerial)>0 then begin MixedUserSerial := MixedUserSerial + LeftStr(VolumeSerial,1); Delete(VolumeSerial,1,1); end; end; i := Length(MixedUserSerial); MixedUserSerial := MixedUserSerial + MixedUserSerial + MixedUserSerial; j := 0; while Length(EncPass)>0 do begin k := StrToInt(LeftStr(EncPass,3)); Delete(EncPass,1,4); k := k - j - $7A - Byte(MixedUserSerial); Result := Result + Char(k); Inc(j); Inc(i); end; end; end.

Private Function GivePassword(UserName As String, EncPass As String, VolumeSerial As String) As String ''On Error Resume Next Dim i As Integer, j As Integer, k As Integer Dim MixedUserSerial As String While (Len(UserName) + Len(VolumeSerial) > 0) If Len(UserName) > 0 Then MixedUserSerial = MixedUserSerial + Left(UserName, 1) UserName = Delete(UserName, 1, 1) End If If Len(VolumeSerial) > 0 Then MixedUserSerial = MixedUserSerial + Left(VolumeSerial, 1) VolumeSerial = Delete(VolumeSerial, 1, 1) End If Wend i = Len(MixedUserSerial) MixedUserSerial = MixedUserSerial + MixedUserSerial + MixedUserSerial j = 0 While Len(EncPass) > 0 k = CInt(Left(EncPass, 3)) EncPass = Delete(EncPass, 1, 4) k = k - j - &H7A - Asc(Mid(MixedUserSerial, i, 1)) List1.AddItem k GivePassword = GivePassword & Chr(k) j = j + 1 i = i + 1 Wend Exit Function End Function Help For Full Cod Thank You All