unit TorrentRarrerUnit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, UPTTreeList, UPTShellControls, UPTSplitter, ExtCtrls,
StdCtrls, ShellAPI, StrUtils, UPTFrame, CRC, IniFiles, ImgList,
CEVersionInfo;
type
TForm1 = class(TForm)
Splitter1: TSplitter;
PTSplitter1: TPTSplitter;
PTShellList1: TPTShellList;
PTShellTree1: TPTShellTree;
Panel2: TPanel;
GroupBox1: TGroupBox;
NoSplitting: TRadioButton;
Memo1: TMemo;
Size15: TRadioButton;
Size50: TRadioButton;
Size100: TRadioButton;
RadioButton7: TRadioButton;
SizeCustom: TEdit;
GroupBox2: TGroupBox;
Store: TRadioButton;
Fastest: TRadioButton;
Fast: TRadioButton;
Normal: TRadioButton;
Good: TRadioButton;
Best: TRadioButton;
GroupBox3: TGroupBox;
ArchiveName: TEdit;
AutoName: TEdit;
ArchiveNameCheckBox: TRadioButton;
AutoNameCheckbox: TRadioButton;
Label1: TLabel;
WinRAR: TLabel;
Label3: TLabel;
ArchivePrefix: TEdit;
OpenDialog1: TOpenDialog;
ListView1: TListView;
CheckBox1: TCheckBox;
Timer1: TTimer;
CheckBox2: TCheckBox;
GroupBox4: TGroupBox;
GroupBox5: TGroupBox;
StatusBar1: TStatusBar;
ImageList1: TImageList;
Button1: TButton;
CEVersionInfo1: TCEVersionInfo;
CheckBox3: TCheckBox;
Size20: TRadioButton;
Size200: TRadioButton;
procedure FormCreate(Sender: TObject);
procedure VerifyRARFile(S : String);
procedure WinRARDblClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure PTShellList1FillComplete(Sender: TObject);
procedure CreateSFV(WorkDir,FileName : String);
procedure Timer1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ReadOptions;
procedure WriteOptions;
private
CurrentlyProcessing,Paused : Boolean;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function ExecAndWait(const FileName: string; WorkDir: string; const CmdShow: Integer): Longword;
var { by Pat Ritchey }
zAppName: array[0..512] of Char;
zCurDir: array[0..255] of Char;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
begin
StrPCopy(zAppName, FileName);
StrPCopy(zCurDir, WorkDir);
FillChar(StartupInfo, SizeOf(StartupInfo), #0);
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := CmdShow;
if not CreateProcess(nil,
zAppName, // pointer to command line string
nil, // pointer to process security attributes
nil, // pointer to thread security attributes
False, // handle inheritance flag
CREATE_NEW_CONSOLE or // creation flags
NORMAL_PRIORITY_CLASS,
nil, //pointer to new environment block
zCurDir, // pointer to current directory name
StartupInfo, // pointer to STARTUPINFO
ProcessInfo) // pointer to PROCESS_INF
then Result := WAIT_FAILED
else
begin
while WaitForSingleObject(ProcessInfo.hProcess, 0) = WAIT_TIMEOUT do
begin
Application.ProcessMessages;
Sleep(50);
end;
{
// or:
repeat
AppIsRunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
Application.ProcessMessages;
Sleep(50);
until (AppIsRunning <> WAIT_TIMEOUT);
}
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess, Result);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
end;
end; { WinExecAndWait32 }
procedure TForm1.FormCreate(Sender: TObject);
Var
S : String;
begin
Caption := CEVersionInfo1.FileDescription + ' v'+CEVersionInfo1.FileVersion;
Memo1.Lines.Add('Launched '+Application.ExeName+' v'+CEVersionInfo1.FileVersion);
Memo1.Lines.Add('');
ReadOptions;
If WinRar.Caption = '' Then
Begin
S := IncludeTrailingPathDelimiter(GetEnvironmentVariable('ProgramFiles'))+'WinRAR\WinRAR.exe';
Memo1.Lines.Add('Attempting to locate '+S);
VerifyRARFile(S);
End Else Memo1.Lines.Add('Browse to the folder containing the files you wish to RAR, check the files you want to RAR, and then click "Add to Queue" for a quick and easy RAR comprising all your favorite settings');
end;
procedure TForm1.VerifyRARFile(S : String);
begin
If FileExists(S) Then
Begin
WinRAR.Caption := S;
Memo1.Lines.Add('Winrar executable found.');
Memo1.Lines.Add('');
Memo1.Lines.Add('Browse to the folder containing the files you wish to RAR, check the files you want to RAR, and then click "Do It" for a quick and easy RAR comprising all your favorite settings');
End
Else
Begin
Memo1.Lines.Add('Winrar executable NOT found!');
Memo1.Lines.Add('');
Memo1.Lines.Add('Please locate your WinRAR.exe file before continuing');
WinRAR.Caption := 'Double click here to locate your WinRAR.exe manually';
Button1.Enabled := False;
End;
end;
procedure TForm1.WinRARDblClick(Sender: TObject);
Var
S : String;
begin
OpenDialog1.InitialDir := GetEnvironmentVariable('ProgramFiles');
If OpenDialog1.Execute Then If OpenDialog1.FileName > '' Then S := OpenDialog1.FileName;
VerifyRARFile(S);
end;
procedure TForm1.Button1Click(Sender: TObject);
Var
S,T,U,V : String;
i : Integer;
j : Int64;
ListItem : TListItem;
TF : TextFile;
Some : Boolean;
begin
S := ArchivePrefix.Text;
If AutoNameCheckbox.Checked Then
Begin
If S > '' Then
Begin
If S[1] = '-' Then
Begin
S := AutoName.Text + S;
End
Else
Begin
S := S + AutoName.Text;
End;
End Else S := AutoName.Text
End
Else
Begin
If S > '' Then
Begin
If S[1] = '-' Then
Begin
S := ArchiveName.Text + S;
End
Else
Begin
S := S + ArchiveName.Text;
End;
End Else S := ArchiveName.Text;
End;
If S = '' Then
Begin
Memo1.Lines.Add('');
Memo1.Lines.Add('Invalid Archive name - must be non-blank');
Exit;
End;
S := S +'.rar';
U := S;
S := S+' ';
// Now Add Files to end;
T := S;
V := PTShellList1.Folder.PathName+'\'+U+'.txt';
AssignFile(TF,V);
Rewrite(TF);
Some := False;
For i := 0 to Pred(PTShellList1.Items.Count) Do if PTShellList1.Items.Item[i].Checked Then
Begin
Writeln(TF,PTShellList1.ShListData[i].FileName);
Some := True;
End;
If Not Some Then
Begin
Memo1.Lines.Add('');
Memo1.Lines.Add('No files were checked - please check some files, OK?');
CloseFile(TF);
DeleteFile(PTShellList1.Folder.PathName+'\'+U+'.txt');
Exit;
End;
S := S + '-n@'+U+'.txt ';
CloseFile(TF);
If NOT NoSplitting.Checked Then
Begin
If Size15.Checked Then j := 15000000 Else
If Size20.Checked Then j := 20000000 Else
If Size50.Checked Then j := 50000000 Else
If Size100.Checked Then j := 100000000 Else
If Size200.Checked Then j := 200000000 Else
j := StrToInt(SizeCustom.Text);
S := '-v'+IntToStr(j)+'b '+S;
If Store.Checked Then S := '-m0 ' +S Else
If Fastest.Checked Then S := '-m1 ' +S Else
If Fast.Checked Then S := '-m2 ' +S Else
If Normal.Checked Then S := '-m3 ' +S Else
If Good.Checked Then S := '-m4 ' +S Else
If Best.Checked Then S := '-m5 ' +S;
End;
If CheckBox1.Checked Then S := '-df '+S;
S := 'a -vn '+S;
ListItem := ListView1.Items.Add;
ListItem.Caption := 'WAITING';
ListItem.SubItems.Add(U);
ListItem.SubItems.Add(WinRAR.Caption+' '+S);
ListItem.SubItems.Add(PTShellList1.Folder.PathName);
ListItem.ImageIndex := 0;
If CheckBox2.Checked Then ListItem.SubItems.Add('YES') Else ListItem.SubItems.Add('NO');
ListItem.SubItems.Add(V);
end;
Function IsDate(S : String) : Boolean;
Var
i : Integer;
Begin
If Length(S) = 0 Then
Begin
Result := False;
Exit;
End;
For i := 1 to Length(S) Do If S[i] in ['0'..'9'] Then
Begin
End Else
Begin
Result := False;
Exit;
End;
Result := True;
End;
procedure TForm1.PTShellList1FillComplete(Sender: TObject);
Var
S,T,U,V : String;
i : Integer;
C : Char;
begin
S := PTShellList1.Folder.PathName;
T := '';
U := '';
If S > '' Then
Begin
// First strip off the last part.
U := S;
S := ReverseString(S);
S := Copy(S,1,Pos('\',S)-1);
S := ReverseString(S);
If S > '' Then
Begin
If (Pos('CD',Uppercase(S))= 1) OR (Pos('SUB',Uppercase(S))= 1) OR (Pos('SAMP',Uppercase(S))= 1) Then
Begin
IF (Pos('CD',Uppercase(S))= 1) Then
Begin
If Length(S) > 2 Then
Begin
T := Copy(S,3,Length(S));
If IsDate(T) Then T := LowerCase(Chr(StrToInt(T)+64));
End;
End Else
Begin
T := S;
End;
// Go Back One More Directory;
S := ReverseString(U);
S := Copy(S,Pos('\',S)+1,Length(S));
S := Copy(S,1,Pos('\',S)-1);
S := ReverseString(S);
End;
If S > '' Then
Begin
// First, Let's find the delimeter;
C := #0;
If C = #0 Then For i := 1 to Length(S) Do If S[i] = ' ' Then C := ' ';
If C = #0 Then For i := 1 to Length(S) Do If S[i] = '.' Then C := '.';
If C = #0 Then For i := 1 to Length(S) Do If S[i] = '_' Then C := '_';
If C <> #0 Then
Begin
V := S;
U := '';
Repeat
S := Copy(V,1,Pos(C,V)-1);
If S = '' Then
Begin
S := V;
V := '';
End Else V := Copy(V,Pos(C,V)+1,Length(V));
If S > '' Then If IsDate(S) Then V := '' Else U := U + LowerCase(S[1]);
Until (Length(V) <= 1);
End Else U := S;
End;
End;
End;
AutoName.Text := U+T;
If DirectoryExists(AutoName.Text) Then AutoName.Text := '';
end;
procedure TForm1.CreateSFV(WorkDir,FileName : String);
Var
StringList : TStringList;
ProcessList : TStringList;
DirInfo : TSearchRec;
i,j : LongInt;
Begin
WorkDir := IncludeTrailingPathDelimiter(WorkDir);
FileName := ChangeFileExt(FileName,'.???');
StringList := TStringList.Create;
If CheckBox3.Checked Then
Begin
StringList.Add('; Generated by EasyRarrer on '+DateTimeToStr(Now));
StringList.Add(';');
End;
Processlist := TStringList.Create;
if FindFirst(WorkDir+FileName,faAnyFile,DirInfo) = 0 then
begin
repeat
if (DirInfo.Attr and faDirectory) <> DirInfo.Attr then
begin
ProcessList.Add(DirInfo.Name);
If CheckBox3.Checked Then StringList.Add(';' +RightStr(' '+IntToStr(DirInfo.Size),15)+' '+DateTimeToStr(FileDateToDateTime(DirInfo.Time))+' '+DirInfo.Name);
end;
until FindNext(DirInfo) <> 0;
end;
FindClose(DirInfo);
If ProcessList.Count > 0 Then for i := 0 to Pred(ProcessList.Count) Do
Begin
FileCRC32(WorkDir+ProcessList.Strings[i],j);
StatusBar1.Panels[1].Text := ProcessList.Strings[i]+' '+IntToHex(j,8);
StringList.Add(ProcessList.Strings[i]+' '+IntToHex(j,8));
Application.ProcessMessages;
End;
ProcessList.Free;
StringList.SaveToFile(WorkDir+ChangeFileExt(FileName,'.sfv'));
StringList.Free;
End;
procedure TForm1.Timer1Timer(Sender: TObject);
Var
i : Integer;
ReturnCode : Cardinal;
begin
Timer1.Enabled := False;
CurrentlyProcessing := True;
If ListView1.Items.Count > 0 Then
Begin
For i := 0 to Pred(ListView1.Items.Count) Do
Begin
If ListView1.Items.Item[i].Caption = 'WAITING' Then
Begin
Memo1.Lines.Add('');
Memo1.Lines.Add('Launching : '+ListView1.Items.Item[i].SubItems.Strings[1]+' '+ListView1.Items.Item[i].SubItems.Strings[2]);
ListView1.Items.Item[i].Caption := 'PROCESSING';
ListView1.Items.Item[i].ImageIndex := 1;
ReturnCode := ExecAndWait(ListView1.Items.Item[i].SubItems.Strings[1],ListView1.Items.Item[i].SubItems.Strings[2],1);
If ReturnCode = 0 Then
Begin
ListView1.Items.Item[i].Caption := 'COMPLETED';
ListView1.Items.Item[i].ImageIndex := 2;
Memo1.Lines.Add('Return Code : ' + FloatToStr(ReturnCode)+ ' (this is good)');
If ListView1.Items.Item[i].SubItems.Strings[3] = 'YES' Then
Begin
Memo1.Lines.Add('Creating SFV : '+ IncludeTrailingPathDelimiter(ListView1.Items.Item[i].SubItems.Strings[2])+ListView1.Items.Item[i].SubItems.Strings[0]);
DeleteFile(ListView1.Items.Item[i].SubItems.Strings[4]);
CreateSFV(ListView1.Items.Item[i].SubItems.Strings[2],ListView1.Items.Item[i].SubItems.Strings[0]);
Memo1.Lines.Add('SFV Created!');
End;
End
Else
Begin
ListView1.Items.Item[i].Caption := 'FAILED';
ListView1.Items.Item[i].ImageIndex := 3;
Memo1.Lines.Add('Return Code : ' + FloatToStr(ReturnCode)+ ' (this is NOT good). i.e. The RAR Process was interrupted or FAILED!');
End;
Break;
End;
End;
End;
PostMessage(Memo1.Handle,WM_VSCROLL, SB_BOTTOM, 0);
CurrentlyProcessing := False;
If NOT Paused Then Timer1.Enabled := True;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
WriteOptions;
end;
procedure TForm1.ReadOptions;
Var
Ini : TIniFile;
begin
Ini := TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini'));
Case Ini.ReadInteger('Options','Split',1) of
0 : NoSplitting.Checked := True;
1 : Size15.Checked := True;
2 : Size20.Checked := True;
3 : Size50.Checked := True;
4 : Size100.Checked := True;
5 : Size200.Checked := True;
Else
Begin
RadioButton7.Checked := True;
SizeCustom.Text := IntToStr(Ini.ReadInteger('options','Split',1));
End;
End;
Case Ini.ReadInteger('Options','Compress',0) of
0 : Store.Checked := True;
1 : Fastest.Checked := True;
2 : Fast.Checked := True;
3 : Normal.Checked := True;
4 : Good.Checked := True;
5 : Best.Checked := True;
End;
ArchiveNameCheckBox.Checked := Ini.ReadBool('Options','UseArchiveName',False);
AutoNameCheckBox.Checked := Ini.ReadBool('Options','UseAutoName',True);
ArchiveName.Text := Ini.ReadString('Options','ArchiveName','');
ArchivePrefix.Text := Ini.ReadString('Options','ArchivePrefix','');
CheckBox1.Checked := Ini.ReadBool('Options','DeleteOriginal',False);
CheckBox2.Checked := Ini.ReadBool('Options','CreateSFV',True);
CheckBox3.Checked := Ini.ReadBool('Options','DetailSFV',True);
WinRar.Caption := Ini.ReadString('Options','WinRARExec','');
If Ini.ReadString('Options','LastDirectory','') > '' Then
PTShellList1.Folder.PathName := Ini.ReadString('Options','LastDirectory','');
Ini.Free;
If WinRar.Caption > '' Then If NOT FileExists(WinRar.Caption) Then WinRar.Caption := '';
end;
procedure TForm1.WriteOptions;
Var
Ini : TIniFile;
i : Integer;
begin
Ini := TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini'));
If NoSplitting.Checked Then i := 0 Else
If Size15.Checked Then i := 1 Else
If Size20.Checked Then i := 2 Else
If Size50.Checked Then i := 3 Else
If Size100.Checked Then i := 4 Else
If Size200.Checked Then i := 5 Else
i := StrToInt(SizeCustom.Text);
Ini.WriteInteger('Options','Split',i);
If Store.Checked Then i := 0 Else
If Fastest.Checked Then i := 1 Else
If Fast.Checked Then i := 2 Else
If Normal.Checked Then i := 3 Else
If Good.Checked Then i := 4 Else
If Best.Checked Then i := 5;
Ini.WriteInteger('Options','Compress',i);
Ini.WriteBool('Options','UseArchiveName',ArchiveNameCheckBox.Checked);
Ini.WriteBool('Options','UseAutoName',AutoNameCheckBox.Checked);
Ini.WriteString('Options','ArchiveName',ArchiveName.Text);
Ini.WriteString('Options','ArchivePrefix',ArchivePrefix.Text);
Ini.WriteBool('Options','DeleteOriginal',CheckBox1.Checked);
Ini.WriteBool('Options','CreateSFV',CheckBox2.Checked);
Ini.WriteBool('Options','DetailSFV',CheckBox3.Checked);
Ini.WriteString('Options','WinRARExec',WinRar.Caption);
Ini.WriteString('Options','LastDirectory',PTShellList1.Folder.PathName);
Ini.Free;
end;
end.