unit fmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  RPARFile = record
    Filename: String;
    Passed: Boolean;
  end;

  TMainForm = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    OpenDialog1: TOpenDialog;
    lblStatus: TLabel;
    pbProgress: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Log(S: String);
  end;

var
  MainForm: TMainForm;

  PARHandle: Cardinal;
  PARFiles: Array of RPARFile;
  PARDirectory: String;

implementation

{$R *.dfm}

uses par2lib_header;

{ TMainForm }

procedure Log(S: String);
begin
  MainForm.Log(S);
end;

function PAR2_PARAvailableCallback(UserData: Cardinal; BlocksNeeded: Cardinal; var ID: Cardinal; var FileSize: Int64): Cardinal; stdcall;
var i: Integer;
    FS: TFileStream;
    Found: Boolean;
begin
  // Give the library a PAR2 file. Normally you would decided what file to
  // download or use by BlocksNeeded and the volXX-XX part of the filename.
  // If no suitable file is available but we can queue it for download,
  // return PAR2_Available_NotYet.
  
  // We're just giving it any file we havent given the library yet.

  //Log('PARAvailable Callback (' + IntToStr(BlocksNeeded) + ')');

  if Length(PARFiles) > 0 then begin
    Found := False;
    for i := 0 to Length(PARFiles) - 1 do begin
      if PARFiles[i].Passed = False then begin
        PARFiles[i].Passed := True;
        ID := i;

        FS := TFileStream.Create(PARFiles[i].Filename, fmOpenRead or fmShareDenyWrite);
        try
          FileSize := FS.Size;
        finally
          FS.Free;
        end;

        Found := True;

        //Log('- Passing ' + IntToStr(ID) + ' (' + IntToStr(FileSize) + ')');
        
        Break;
      end;
    end;

    if Found then
      Result := PAR2_Available_Yes
    else
      Result := PAR2_Available_Never;
  end else Result := PAR2_Available_Never;
end;

function PAR2_PARNeededCallback(UserData: Cardinal; ID: Cardinal; StartPos: Int64; Length: Cardinal; var Buffer: Pointer; var BufferSize: Cardinal; var FreeBuffer: Cardinal): Cardinal; stdcall;
var FS: TFileStream;
begin
  // Let's pass the PAR2 data that is requested

  //Log('PARNeeded Callback: ' + IntToStr(ID) + ' (' + IntToStr(StartPos) + ' / ' + IntToStr(Length) + ')');

  FS := TFileStream.Create(PARFiles[ID].Filename, fmOpenRead or fmShareDenyWrite);
  try
    GetMem(Buffer, Length);
    FS.Seek(StartPos, soBeginning);
    BufferSize := FS.Read(Buffer^, Length);
    FreeBuffer := PAR2_True;
    Result := PAR2_True;
  finally
    FS.Free;
  end;
end;

function PAR2_DataAvailableCallback(UserData: Cardinal; Filename: PChar; StartPos: Int64; Length: Cardinal): Cardinal; stdcall;
var FN: String;
    FS: TFileStream;
begin
  // Let's see if we have it! In a download tool you would return
  // PAR2_Availabe_NotYet if the file is still queued.

  //Log('DataAvailable: ' + Filename + ' (' + IntToStr(StartPos) + ' / ' + IntToStr(Length) + ')');

  FN := PARDirectory + Filename;
  if FileExists(FN) then begin
    FS := TFileStream.Create(FN, fmOpenRead or fmShareDenyWrite);
    try
      // Check only if StartPos is available. StartPos + Length may be
      // larger than filesize.
      if FS.Size >= StartPos then
        Result := PAR2_Available_Yes
      else
        Result := PAR2_Available_Never;
    finally
      FS.Free;
    end;
  end else
    Result := PAR2_Available_Never;
end;

function PAR2_DataNeededCallback(UserData: Cardinal; Filename: PChar; StartPos: Int64; Length: Cardinal; var Buffer: Pointer; var BufferSize: Cardinal; var FreeBuffer: Cardinal): Cardinal; stdcall;
var FN: String;
    FS: TFileStream;
begin
  // Let's return the data the library wants

  //Log('DataNeeded: ' + Filename + ' (' + IntToStr(StartPos) + ' / ' + IntToStr(Length) + ')');

  FN := PARDirectory + Filename;
  FS := TFileStream.Create(FN, fmOpenRead or fmShareDenyWrite);
  try
    GetMem(Buffer, Length);
    FS.Seek(StartPos, soBeginning);
    BufferSize := FS.Read(Buffer^, Length);
    FreeBuffer := PAR2_True;
    Result := PAR2_True;
  finally
    FS.Free;
  end;
end;

procedure PAR2_ReadProgressCallback(UserData: Cardinal; Current: Cardinal; Maximum: Cardinal; Percent: Cardinal); stdcall;
begin
  // Get some progress
  with MainForm do begin
    lblStatus.Caption := 'Reading';
    pbProgress.Min := 0;
    pbProgress.Max := Maximum;
    pbProgress.Position := Current;

    Application.ProcessMessages;
  end;
end;

procedure PAR2_RepairedBlockCallback(UserData: Cardinal; Filename: PChar; StartPos: Int64; Buffer: Pointer; BufferSize: Cardinal); stdcall;
var FN: String;
    FS: TFileStream;
begin
  // Write the fixed (or repositioned) blocks to file

  Log('Repair Callback: ' + Filename + ' (' + IntToStr(StartPos) + ' / ' + IntToStr(BufferSize) + ')');

  FN := PARDirectory + Filename;
  FS := TFileStream.Create(FN, fmOpenReadWrite or fmShareDenyWrite);
  try
    FS.Seek(StartPos, soBeginning);
    FS.Write(Buffer^, BufferSize);
  finally
    FS.Free;
  end;
end;

procedure PAR2_RepairProgressCallback(UserData: Cardinal; Stage: Cardinal; isPercent: Cardinal; Percent: Cardinal); stdcall;
begin
  // Get some progress
  with MainForm do begin
    if isPercent = PAR2_False then begin
      pbProgress.Min := 0;
      pbProgress.Max := 100;
      pbProgress.Position := 0;
    end else begin
      if (Percent = PAR2_Repair_Progress_Percent_Start) OR (Percent = PAR2_Repair_Progress_Percent_Done) then begin
        case Stage of
          PAR2_Repair_Progress_Start:           lblStatus.Caption := 'Repairing';
          PAR2_Repair_Progress_Repair_Position: lblStatus.Caption := 'Repositioning Blocks';
          PAR2_Repair_Progress_Repair_Matrix:   lblStatus.Caption := 'Generating Matrix';
          PAR2_Repair_Progress_Repair_Blocks:   lblStatus.Caption := 'Repairing Blocks';
          PAR2_Repair_Progress_Done:            lblStatus.Caption := 'Done';
        end;

        lblStatus.Invalidate;
        lblStatus.Update;

        Application.ProcessMessages;
        Application.ProcessMessages;
        Application.ProcessMessages;
      end else begin
        pbProgress.Position := Percent;
      end;
    end;
  end;
end;

procedure PAR2_FreeMemCallback(UserData: Cardinal; P: Pointer); stdcall;
begin
  // Free blocks that were allocated by us. We use GetMem, so use FreeMem here

  // Log('FreeMem Callback');
  
  FreeMem(P);
end;

procedure TMainForm.Log(S: String);
begin
  ListBox1.Items.Add(S);
  ListBox1.ItemIndex := ListBox1.Items.Count - 1;
  ListBox1.Invalidate;
  ListBox1.Update;

  Application.ProcessMessages;
  Application.ProcessMessages;
  Application.ProcessMessages;
end;

procedure TMainForm.Button1Click(Sender: TObject);
var i: Integer;
    Ret: Cardinal;
begin
  if OpenDialog1.Execute then begin
    ListBox1.Items.Clear;

    if OpenDialog1.Files.Count > 0 then begin
      SetLength(PARFiles, OpenDialog1.Files.Count);
      for i := 0 to OpenDialog1.Files.Count - 1 do begin
        PARFiles[i].Filename := OpenDialog1.Files[i];
        PARFiles[i].Passed := False;
      end;

      PARDirectory := ExtractFilePath(PARFiles[0].Filename);
      if PARDirectory[Length(PARDirectory)] <> '\' then
        PARDirectory := PARDirectory + '\';

      // We already got a handle? Free it
      if (PARHandle <> 0) then
        PAR2_Free(PARHandle);

      PARHandle := PAR2_Init(52428800); // 50 MB
      if PARHandle <> 0 then begin
        // Setup callbacks
        PAR2_SetPARAvailable(PARHandle, PAR2_PARAvailableCallback);
        PAR2_SetPARNeeded(PARHandle, PAR2_PARNeededCallback);
        PAR2_SetDataAvailable(PARHandle, PAR2_DataAvailableCallback);
        PAR2_SetDataNeeded(PARHandle, PAR2_DataNeededCallback);
        PAR2_SetReadProgress(PARHandle, PAR2_ReadProgressCallback);
        PAR2_SetRepairProgress(PARHandle, PAR2_RepairProgressCallback);
        PAR2_SetRepairedBlock(PARHandle, PAR2_RepairedBlockCallback);
        PAR2_SetFreeMem(PARHandle, PAR2_FreeMemCallback);

        // Go!
        lblStatus.Caption := 'Initialising';
        Ret := PAR2_Go(PARHandle);

        // Let's see what we did
        if Ret = PAR2_Go_Success then
          Log('Go: No repair necessary')
        else if Ret < PAR2_Go_Error_Base then
          Log('Go: ' + IntToStr(Ret) + ' more blocks needed')
        else if Ret = PAR2_Go_Error_Need_Par then
          Log('Go: PAR2 file needed')
        else if Ret = PAR2_Go_Error_Repair_Not_possible then
          Log('Go: Repair not possible')
        else if Ret = PAR2_Go_Error_Call_Repair then begin
          Log('Go: Repair needed');

          if PAR2_Repair(PARHandle) = PAR2_True then
            Log('Repair: Success')
          else
            Log('Repair: Fail');
        end;
      end;
    end;
  end;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  // Still got a handle? Free it
  PAR2_Free(PARHandle);
  PARHandle := 0;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  SetLength(PARFiles, 0);
  PARHandle := 0;
end;

end.
