unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Contnrs, TBX, TBXDkPanels, TB2Dock, ExtCtrls, TB2Item,
  TB2Toolbar, StdCtrls, ComCtrls, TBXOfficeXPTheme, TBXSwitcher,
  TB2ToolWindow, TB2ExtItems, TBXExtItems, ShellCtrls, ImgList, XPMan;


const
  CM_INIT = WM_USER + 229;
  CDatFile = 'conversions.ini';

type
  TConversion = class
    OldClassName: string;
    NewClassName: string;
    CheckBox: TTBXCheckBox;
  end;

  { TConverterForm }
  TConverterForm = class(TForm)
    TBDock1: TTBDock;
    TBDock2: TTBDock;
    TBDock3: TTBDock;
    TBDock4: TTBDock;
    Panel1: TTBXDockablePanel;
    ConversionsPanel: TTBXAlignmentPanel;
    TBXLabel1: TTBXLabel;
    TBXLabel2: TTBXLabel;
    TBXAlignmentPanel1: TTBXAlignmentPanel;
    FilterPas: TTBXCheckBox;
    FilterHpp: TTBXCheckBox;
    FilterCPP: TTBXCheckBox;
    FilterDFM: TTBXCheckBox;
    FilterBinaryDFM: TTBXCheckBox;
    TBXToolbar1: TTBXToolbar;
    TBXItem1: TTBXItem;
    TBXItem2: TTBXItem;
    TBXSeparatorItem1: TTBXSeparatorItem;
    TBXToolbar2: TTBXToolbar;
    TBXVisibilityToggleItem1: TTBXVisibilityToggleItem;
    Memo: TMemo;
    TBXSwitcher1: TTBXSwitcher;
    TBXPageScroller1: TTBXPageScroller;
    TBXAlignmentPanel3: TTBXAlignmentPanel;
    ConversionCombo: TTBXComboBoxItem;
    TBXLabelItem1: TTBXLabelItem;
    Panel2: TPanel;
    Memo1: TMemo;
    FilePanel: TTBXDockablePanel;
    ShellTreeView: TShellTreeView;
    TBXVisibilityToggleItem2: TTBXVisibilityToggleItem;
    ImageList1: TImageList;
    TBXSeparatorItem3: TTBXSeparatorItem;
    XPManifest1: TXPManifest;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TBXItem1Click(Sender: TObject);
    procedure TBXItem2Click(Sender: TObject);
    procedure ConversionComboPopup(Sender: TTBCustomItem; FromLink: Boolean);
    procedure ConversionComboChange(Sender: TObject; const Text: String);
    procedure ShellTreeViewAddFolder(Sender: TObject; AFolder: TShellFolder; var CanAdd: Boolean);
    procedure FilterChange(Sender: TObject);
    procedure ShellTreeViewDblClick(Sender: TObject);
    procedure TBXVisibilityToggleItem2Click(Sender: TObject);
    procedure MemoDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure MemoDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure ShellTreeViewEditing(Sender: TObject; Node: TTreeNode;
      var AllowEdit: Boolean);
  private
    FConversions: TObjectList;
    procedure CMInit(var Message: TMessage); message CM_INIT;
    procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES;
  protected
    procedure ShowConversions;
    procedure GetConversionTypes(L: TStrings);
    procedure GetConversions(const ConvType: string);
  public
    procedure ProcessFiles(FileNames: TStringList);
  end;

var
  ConverterForm: TConverterForm;

implementation

uses
  ShellApi;

const
  CNameFirst = ['a'..'z', 'A'..'Z', '_'];
  CNameChar = ['a'..'z', 'A'..'Z', '_', '0'..'9'];

type
  TTreeViewAccess = class(TCustomTreeView);

function WordReplace(const Src, OldWord, NewWord: string): string;
var
  P, PStart: PChar;
  S: string;
begin
  Result := '';
  P := PChar(Src);
  PStart := P;
  while P^ <> #0 do
  begin
    if P^ in CNameFirst then
    begin
      SetString(S, PStart, P - PStart);
      Result := Result + S;
      PStart := P;
      Inc(P);
      while P^ in CNameChar do Inc(P);
      SetString(S, PStart, P - PStart);
      if SameText(S, OldWord) then S := NewWord;
      Result := Result + S;
      PStart := P;
    end
    else Inc(P);
  end;
  if P <> PStart then
  begin
    SetString(S, PStart, P - PStart);
    Result := Result + S;
  end;
end;

{$R *.dfm}

{ TConverterForm }

procedure TConverterForm.CMInit(var Message: TMessage);
begin
  DragAcceptFiles(Handle, True);
  ShowConversions;
  TTreeViewAccess(ShellTreeView).MultiSelect := True;
  TTreeViewAccess(ShellTreeView).MultiSelectStyle := [msControlSelect, msShiftSelect, msSiblingOnly];
end;

procedure TConverterForm.FormCreate(Sender: TObject);
begin
  FConversions := TObjectList.Create;
  GetConversionTypes(ConversionCombo.Strings);
  if ConversionCombo.Strings.Count = 0 then raise Exception.Create('Invalid conversion settings');
  ConversionCombo.ItemIndex := 0;
  GetConversions(ConversionCombo.Strings[0]);
  PostMessage(Handle, CM_INIT, 0, 0);
end;

procedure TConverterForm.FormDestroy(Sender: TObject);
begin
  FConversions.Free;
end;

procedure TConverterForm.ProcessFiles(FileNames: TStringList);
var
  I, J: Integer;
  S, E: string;
  BinaryStream: TFileStream;
  StringStream: TStringStream;
  S1, S2: string;
  DFM, BinaryDFM: Boolean;

  function IsTextDFM(const FN: string): Boolean;
  var
    Stream: TFileStream;
    Buffer: array [0..7] of Char;
  begin
    Stream := TFileStream.Create(FN, fmOpenRead);
    FillChar(Buffer[0], 8, 0);
    Stream.Read(Buffer[0], 7);
    Result := SameText(Buffer, 'object ');
    Stream.Free;
  end;

  function IsBinaryDFM(const FN: string): Boolean;
  var
    Stream: TFileStream;
    TS: TStream;
  begin
    Result := True; Exit;
    Stream := TFileStream.Create(FN, fmOpenRead);
    try
      TS := TMemoryStream.Create;
      try
        try
          Result := True;
          ObjectResourceToText(Stream, TS);
        except
          Result := False;
        end;
      finally
        TS.Free;
      end;
    finally
      Stream.Free;
    end;
  end;

  function GetBackupFileName(F: string): string;
  var
    I: Integer;
  begin
    I := 0;
    repeat
      Inc(I);
      Result := Format('%s.###%.3d', [F, I]);
    until not FileExists(Result);
  end;

begin
  { Filter files }
  for I := FileNames.Count - 1 downto 0 do
  begin
    S := FileNames[I];
    E := ExtractFileExt(S);
    if (SameText(E, '.pas') and FilterPAS.Checked) or
      ((SameText(E, '.h') or SameText(E, '.hpp')) and FilterHPP.Checked) or
      (SameText(E, '.cpp') and FilterCPP.Checked) or
      (SameText(E, '.dfm') and FilterDFM.Checked and IsTextDFM(S)) or
      (SameText(E, '.dfm') and FilterBinaryDFM.Checked and IsBinaryDFM(S)) then
      Continue
    else
      FileNames.Delete(I);
  end;
  if FileNames.Count = 0 then Memo.Lines.Add('No files to process');

  { Get each file as string }
  for I := FileNames.Count - 1 downto 0 do
  begin
    DFM := SameText(ExtractFileExt(FileNames[I]), '.dfm');
    if DFM then BinaryDFM := not IsTextDFM(FileNames[I]) else BinaryDFM := False;
    if DFM and BinaryDFM then
    begin
      BinaryStream := TFileStream.Create(FileNames[I], fmOpenRead);
      try
        StringStream := TStringStream.Create('');
        try
          ObjectResourceToText(BinaryStream, StringStream);
          S := StringStream.DataString;
        finally
          StringStream.Free;
        end;
      finally
        BinaryStream.Free;
      end;
    end
    else
    begin
      with TFileStream.Create(FileNames[I], fmOpenRead) do
      try
        SetLength(S, Size);
        ReadBuffer(S[1], Size);
      finally
        Free;
      end;
    end;

    Memo.Lines.Add('Converting ' + FileNames[I]);
    { Now S contains text representation of the file }
    for J := 0 to FConversions.Count - 1 do
      with TConversion(FConversions[J]) do
        if CheckBox.Checked then
          if DFM then
          begin
            S1 := ': ' + OldClassName + #13;
            S2 := ': ' + NewClassName + #13;
            S := StringReplace(S, S1, S2, [rfReplaceAll, rfIgnoreCase]);
          end
          else
          begin
            S := WordReplace(S, OldClassName, NewClassName);
          end;

    E := GetBackupFileName(FileNames[I]);
    Memo.Lines.Add('Saving original file to ' + E);
    RenameFile(FileNames[I], E);

    if DFM and BinaryDFM then
    begin
      BinaryStream := TFileStream.Create(FileNames[I], fmCreate);
      try
        StringStream := TStringStream.Create(S);
        try
          ObjectTextToResource(StringStream, BinaryStream);
        finally
          StringStream.Free;
        end;
      finally
        BinaryStream.Free;
      end;
    end
    else
    begin
      with TFileStream.Create(FileNames[I], fmCreate) do
      try
        WriteBuffer(S[1], Length(S));
      finally
        Free;
      end;
    end;
  end;
end;

procedure TConverterForm.ShowConversions;
var
  I: Integer;
  C: TConversion;
  CB: TTBXCheckBox;
begin
  ConversionsPanel.DisableAlign;
  for I := ConversionsPanel.ControlCount - 1 downto 0 do
    ConversionsPanel.Controls[I].Free;
  for I := 0 to FConversions.Count - 1 do
  begin
    C := TConversion(FConversions[I]);
    CB := TTBXCheckBox.Create(Self);
    CB.Caption := C.OldClassName + ' > ' + C.NewClassName;
    CB.Wrapping := twEndEllipsis;
    CB.Top := 10000;
    CB.Parent := ConversionsPanel;
    CB.Align := alTop;
    CB.Checked := True;
    C.CheckBox := CB;
  end;
  ConversionsPanel.EnableAlign;
  ConversionsPanel.Realign;
end;

procedure TConverterForm.WMDropFiles(var Message: TWMDropFiles);
var
  SL: TStringList;
  Buffer: array [0..1024] of Char;
  NumFiles, I: Integer;
  S: string;
begin
  SL := TStringList.Create;
  try
    NumFiles := DragQueryFile(Message.Drop, $FFFFFFFF, nil, 0);
    for I := 0 to NumFiles - 1 do
    begin
      DragQueryFile(Message.Drop,I, Buffer, SizeOf(Buffer));
      S := StrPas(Buffer);
      if FileExists(S) then SL.Add(S);
    end;
    if SL.Count > 0 then ProcessFiles(SL);
  finally
    SL.Free;
  end;
end;

procedure TConverterForm.TBXItem1Click(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to FConversions.Count - 1 do
    TConversion(FConversions[I]).CheckBox.Checked := True;
end;

procedure TConverterForm.TBXItem2Click(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to FConversions.Count - 1 do
    TConversion(FConversions[I]).CheckBox.Checked := False;
end;

procedure TConverterForm.ConversionComboPopup(Sender: TTBCustomItem; FromLink: Boolean);
begin
  GetConversionTypes(ConversionCombo.Strings);
end;

procedure TConverterForm.GetConversionTypes(L: TStrings);
var
  SL: TStringList;
  S: string;
  I, J: Integer;
begin
  SL := TStringList.Create;
  try
    SL.LoadFromFile(CDatFile);
    L.Clear;
    for I := 0 to SL.Count - 1 do
    begin
      S := Trim(SL[I]);
      if (Length(S) > 3) and (S[1] = '[') and (S[Length(S)] = ']') then
      begin
        S := Copy(S, 2, Length(S) - 2);
        L.Add(S);
      end;
    end;
  finally
    SL.Free;
  end;
end;

procedure TConverterForm.ConversionComboChange(Sender: TObject; const Text: String);
begin
  GetConversions(Text);
  ShowConversions;
end;

procedure TConverterForm.GetConversions(const ConvType: string);
var
  SL: TStringList;
  S, S1, S2: string;
  P: Integer;
  C: TConversion;
  I: Integer;
begin
  SL := TStringList.Create;
  try
    SL.LoadFromFile(CDatFile);
    I := 0;
    while I < SL.Count - 1 do
    begin
      S := Trim(SL[I]);
      if (Length(S) > 3) and (S[1] = '[') and (S[Length(S)] = ']') and
        SameText(Copy(S, 2, Length(S) - 2), ConvType) then Break
      else Inc(I);
    end;

    FConversions.Clear;
    Inc(I);
    while I < SL.Count do
    begin
      S := Trim(SL[I]);
      Inc(I);
      if (Length(S) = 0) or (S[1] in [';', '''', '/', '%']) then Continue;
      if S[1] = '[' then Break;
      P := Pos('->', S);
      if P < 2 then raise Exception.Create('Invalid conversion settings');
      S1 := Trim(Copy(S, 1, P - 1));
      S2 := Trim(Copy(S, P + 2, Length(S)));
      if (Length(S1) = 0) or (Length(S2) = 0) then raise Exception.Create('Invalid conversion settings');
      C := TConversion.Create;
      FConversions.Add(C);
      C.OldClassName := S1;
      C.NewClassName := S2;
    end;
  finally
    SL.Free;
  end;
end;

procedure TConverterForm.ShellTreeViewAddFolder(Sender: TObject;
  AFolder: TShellFolder; var CanAdd: Boolean);
var
  Ext: string;
begin
  if not AFolder.IsFolder then
  begin
    Ext := LowerCase(ExtractFileExt(AFolder.DisplayName));
    CanAdd :=
      (FilterPas.Checked and (Ext = '.pas')) or
      (FilterHpp.Checked and ((Ext = '.h') or (Ext = '.hpp'))) or
      (FilterCpp.Checked and (Ext = '.cpp')) or
      ((FilterDfm.Checked or FilterBinaryDfm.Checked) and (Ext = '.dfm'));
  end;
end;

procedure TConverterForm.FilterChange(Sender: TObject);
begin
  if FilePanel.Visible then
    ShellTreeView.Refresh(ShellTreeView.Items[0]);
end;

procedure TConverterForm.ShellTreeViewDblClick(Sender: TObject);
var
  SL: TStringList;
begin
  SL := TStringList.Create;
  try
    SL.Add(ShellTreeView.SelectedFolder.PathName);
    if FileExists(SL[0]) then ProcessFiles(SL);
  finally
    SL.Free;
  end;
end;

procedure TConverterForm.TBXVisibilityToggleItem2Click(Sender: TObject);
begin
  if FilePanel.Visible then
    ShellTreeView.Refresh(ShellTreeView.Items[0]);
end;

procedure TConverterForm.MemoDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  I: Integer;
  SL: TStringList;
begin
  if Source <> ShellTreeView then Exit;
  SL := TStringList.Create;
  try
    for I := 0 to ShellTreeView.SelectionCount - 1 do
      SL.Add(TShellFolder(ShellTreeView.Selections[I].Data).PathName);
    ProcessFiles(SL);
  finally
    SL.Free;
  end;
end;

procedure TConverterForm.MemoDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  I: Integer;
begin
  if Source <> ShellTreeView then Exit;
  for I := 0 to ShellTreeView.SelectionCount - 1 do
    if not FileExists(TShellFolder(ShellTreeView.Selections[I].Data).PathName) then
    begin
      Accept := False;
      Break;
    end;
end;

procedure TConverterForm.ShellTreeViewEditing(Sender: TObject;
  Node: TTreeNode; var AllowEdit: Boolean);
begin
  AllowEdit := False;
end;

end.