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.