⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 big52gb.pas

📁 Big5和GB码相互转换
💻 PAS
字号:
unit big52gb;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, lmdclass, lmdctrl, lmddlgS, ExtCtrls, ComCtrls,cvcode,FileCtrl,
  Menus, lmdbtn, lmdnonvS, lmdcompo, FileFinder, bsutils, Confirm, DCGen,
  dcmemo, dcstring, dcsystem, dcparser, LMDFileCtrl;

type
  TConvertType = (ctBigGB,ctText, ctEditHTML);
  TForm1 = class(TForm)
    Label2: TLabel;
    edSource: TEdit;
    LMDDirDlg1: TLMDDirDlg;                            
    Label3: TLabel;
    edDest: TEdit;
    btnStart: TButton;
    RadioGroup1: TRadioGroup;
    cbOverwrite: TCheckBox;
    Bevel1: TBevel;
    Label1: TLabel;
    edFileName: TEdit;
    StatusBar1: TStatusBar;
    OpenDialog1: TOpenDialog;
    btnSelect: TLMDSpeedButton;
    PopupMenu1: TPopupMenu;
    LMDMRUList1: TLMDMRUList;
    N1: TMenuItem;
    LMDMRUList2: TLMDMRUList;
    PopupMenu2: TPopupMenu;
    N2: TMenuItem;
    LMDSpeedButton1: TLMDSpeedButton;
    CheckSubDir: TCheckBox;
    FileFinder1: TFileFinder;
    ConvertToText: TButton;
    HTMLParser: THTMLParser;
    EditHTML: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnSelectClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure LMDMRUList1Click(Sender: TObject; const aValue: String;
      var Remove: Boolean);
    procedure LMDMRUList2Click(Sender: TObject; const aValue: String;
      var Remove: Boolean);
    procedure FileFinder1FileFound(Sender: TObject; Directory: String;
      SearchRec: TSearchRec; var Stop: Boolean);
    procedure CheckSubDirClick(Sender: TObject);
    procedure ConvertToTextClick(Sender: TObject);
    procedure EditHTMLClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    ConvertAll : Boolean;
    StopIt : Boolean;
    ConvertType : TConvertType;
    TheFileList :TStringList;
    procedure HtmlToText(Directory: String;SearchRec: TSearchRec);
    function CreateDestFileName(Directory: String;SearchRec: TSearchRec):String;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;                                  

implementation

uses EditHTML;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  edSource.Text := ExtractFilepath(Application.Exename);
  TheFileList := TStringList.Create;
end;

procedure TForm1.btnSelectClick(Sender: TObject);
begin
  if lmdDirDlg1.Execute then
  begin
    edSource.Text:=lmdDirDlg1.Path;
    LmdMruList1.Add(edSource.Text);
    if edDest.Text ='' then
      edDest.Text:=lmdDirDlg1.Path+'\Convert\';
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if lmdDirDlg1.Execute then
  begin
    edDest.Text:=lmdDirDlg1.Path;
    LmdMruList2.Add(edSource.Text);
    if edSource.Text ='' then
      edSource.Text:=lmdDirDlg1.Path;
  end;
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
   FileFinder1.Root :=slash(edSource.Text);
   FileFinder1.FileName := EdFileName.Text;
   ConvertAll := False;
   StopIt := False;
   ConvertType := ctBigGB;
   FileFinder1.Search;
   ShowMessage('OK');
end;

procedure TForm1.LMDMRUList1Click(Sender: TObject; const aValue: String;
  var Remove: Boolean);
begin
  edSource.Text:=aValue;
end;

procedure TForm1.LMDMRUList2Click(Sender: TObject; const aValue: String;
  var Remove: Boolean);
begin
  edDest.Text:=aValue;
end;

procedure TForm1.FileFinder1FileFound(Sender: TObject; Directory: String;
  SearchRec: TSearchRec; var Stop: Boolean);
var
  I : integer;
  sourcelist,destList:TStringList;
  tempStr:String;
  sName,destName:String;
  IsTextFile : Boolean;
  FileExt :  String;
begin
  if ConvertType = ctText then
  begin
    HtmlToText(Directory,SearchRec);
    Exit;
  end;
  if ConvertType = ctEditHTML then
  begin
    TheFileList.Add(Directory+SearchRec.Name);
    Exit;
  end;


  sourceList:=TStringList.Create;
  destList:=TStringList.Create;
  try
//    messageBeep(0);
    sourceList.Clear;
    destList.Clear;
    sName:=Directory+SearchRec.Name;

    FileExt := UpperCase(ExtractFileExt(SearchRec.Name));
    IsTextFile := (FileExt = '.TXT' ) or (FileExt='.HTM')
      or(FileExt = '.HTML');
    if IsTextFile then sourceList.LoadFromFile(sName);
    if ConvertAll = False then
    begin
      ConfirmForm.Memo1.Lines.Assign(sourceList);
      ConfirmForm.ConvertAll := ConvertAll;
      ConfirmForm.StopIt := StopIT;
      if ConfirmForm.ShowModal = mrCancel then
      begin
        ConvertAll := ConfirmForm.Convertall;
        destName := CreateDestFileName(Directory,SearchRec);
        if (FileExists(destName)) and (not cbOverwrite.Checked) then
          if MessageDlg('File exists,Are you sure to overwrite it?', mtWarning, [mbOK], 0) <> mrOk then
            Exit;
        if IsTextFile then SourceList.SaveToFile(destName)
        else CopyFile(PChar(sName),PChar(DestName),False);
        Exit;
      end else
      begin
        ConvertAll := ConfirmForm.Convertall;
        StopIt := ConfirmForm.StopIt;
        if StopIt then Stop := True;
      end;
    end;
    SearchRec.Name := Big5ToGb(SearchRec.Name);
    Directory := Big5ToGb(Directory);

    StatusBar1.SimpleText := SearchRec.Name + ' Size : ' + IntToStr(SearchRec.Size);

    for i:=0 to sourceList.Count-1 do
    begin
      tempStr:=Big5ToGb(sourceList.Strings[i]);
      destList.Add(tempStr);
    end;

    destName := CreateDestFileName(Directory,SearchRec);
    if (FileExists(destName)) and (not cbOverwrite.Checked) then
      if MessageDlg('File exists,Are you sure to overwrite it?', mtWarning, [mbOK], 0) <> mrOk then
        Exit;
    if IsTextFile then destList.SaveToFile(destName)
    else CopyFile(PChar(sName),PChar(DestName),False);
  finally
    sourceList.Free;
    destList.Free;
  end;
end;

procedure TForm1.CheckSubDirClick(Sender: TObject);
begin
  FileFinder1.SubFolders := CheckSubDir.Checked;
end;

procedure TForm1.ConvertToTextClick(Sender: TObject);
begin
  FileFinder1.Root :=slash(edSource.Text);
  FileFinder1.FileName := EdFileName.Text;
  ConvertAll := False;
  ConvertType := ctText;
  FileFinder1.Search;
  ShowMessage('OK');
end;

procedure TForm1.HtmlToText(Directory: String; SearchRec: TSearchRec);
var
  I : integer;
  sourcelist,destList:TStringList;
  tempStr:String;
  sName,destName:String;
  CurrLine:integer;
begin
  sourceList:=TStringList.Create;
  destList:=TStringList.Create;
  try
//    messageBeep(0);
    sourceList.Clear;
    destList.Clear;
    sName:=Directory+SearchRec.Name;
    sourceList.LoadFromFile(sName);
    StatusBar1.SimpleText := SearchRec.Name + ' Size : ' + IntToStr(SearchRec.Size);

    for i:=0 to sourceList.Count-1 do
    begin
      tempStr:=striptags(sourceList.Strings[i]);
      destList.Add(tempStr);
    end;
    if edDest.Text = '' then
    begin
      destName:=Directory;
{      if not DirectoryExists(destName+'convert\') then
        ForceDirectories(destName+'convert\');}
      destName:=Directory+ExtractFilename(SearchRec.Name);
    end else
    begin
      tempStr := Directory;
      Delete(TempStr,1,Length(FileFinder1.Root));
      destName:=slash(edDest.Text)+Tempstr;
{      if not DirectoryExists(destName) then
        ForceDirectories(destName);}
      destName:=slash(DestName)+ExtractFilename(SearchRec.Name);
    end;
    if (FileExists(destName)) and (not cbOverwrite.Checked) then
      if MessageDlg('File exists,Are you sure to overwrite it?', mtWarning, [mbOK], 0) <> mrOk then
        Exit;
    destList.SaveToFile(ChangeFileExt(destName,'.txt'));
  finally
    sourceList.Free;
    destList.Free;
  end;
end;

procedure TForm1.EditHTMLClick(Sender: TObject);
begin
  FileFinder1.Root :=slash(edSource.Text);
  FileFinder1.FileName := EdFileName.Text;
  ConvertAll := False;
  ConvertType := ctEditHTML;
  TheFileList.Clear;
  FileFinder1.Search;
  EditHTMLForm.ListBox1.Items.Assign(TheFileList);
  EditHTMLForm.ShowModal;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  TheFileList.Free;
end;

function TForm1.CreateDestFileName(Directory: String;
  SearchRec: TSearchRec): String;
var
  tempStr : string;
begin
  if edDest.Text = '' then
  begin
    Result:=Directory;
    if not DirectoryExists(Result+'convert\') then
      ForceDirectories(Result+'convert\');
    Result:=Directory+'convert\'+ExtractFilename(SearchRec.Name);
  end else
  begin
    tempStr := Directory;
    Delete(TempStr,1,Length(FileFinder1.Root));
    Result:=slash(edDest.Text)+Tempstr;
    if not DirectoryExists(Result) then
      ForceDirectories(Result);
    Result:=slash(Result)+ExtractFilename(SearchRec.Name);
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -