unit1.~pas

delphi更换生成的xml记录中的图像

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, XMLDoc, StdCtrls, Buttons, ExtCtrls, EncdDecd, jpeg, FileCtrl,
  SUIComboBox, SUIListBox, FindFile, ComCtrls;

type
  TForm1 = class(TForm)
    pnl1: TPanel;
    stat1: TStatusBar;
    pnl2: TPanel;
    FindFile: TFindFile;
    pnl3: TPanel;
    bvl1: TBevel;
    img1: TImage;
    pnl4: TPanel;
    suiDriveComboBox1: TsuiDriveComboBox;
    Label1: TLabel;
    suiFileListBox1: TsuiFileListBox;
    suiDirectoryListBox1: TsuiDirectoryListBox;
    pnl5: TPanel;
    chk1: TCheckBox;
    edt1: TEdit;
    btn3: TButton;
    btn1: TButton;
    procedure btn3Click(Sender: TObject);
    procedure FindFileFileMatch(Sender: TObject; const Folder: string;
      const FileInfo: TSearchRec);
    procedure FindFileFolderChange(Sender: TObject; const Folder: string;
      var IgnoreFolder: TFolderIgnore);
    procedure FindFileSearchAbort(Sender: TObject);
    procedure FindFileSearchBegin(Sender: TObject);
    procedure FindFileSearchFinish(Sender: TObject);
    procedure suiFileListBox1DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btn1Click(Sender: TObject);
  private
    Folders: Integer;
    count: Integer;
    StartTime: DWord;
    SortedColumn: Integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btn3Click(Sender: TObject);
begin
  with FindFile.Criteria.Files do
  begin
    FileName := '*.xml';
    Location := suiDirectoryListBox1.Directory;
    Subfolders := chk1.Checked;
  end;
  FindFile.Execute;
end;

procedure TForm1.FindFileFileMatch(Sender: TObject; const Folder: string;
  const FileInfo: TSearchRec);
var
  fxml: TXMLDocument;
  ts, ts2: TmemoryStream;
  tl: TStringList;
  pic: string;

begin
  Inc(count);
  stat1.SimpleText := Folder + fileinfo.Name;
  ts := Tmemorystream.Create;
  ts2 := TMemoryStream.Create;
  tl := TStringList.Create;
  try
    ts.Position := 0;
    ts.LoadFromFile(edt1.Text);
    encodestream(ts, ts2);
    ts2.Position := 0;
    tl.LoadFromStream(ts2);
    pic := tl.Text;
  finally
    tl.Free;
    ts.Free;
    ts2.Free;
  end;
  fxml := TXMLDocument.Create(self);
  try
    fxml.LoadFromFile(Folder + fileinfo.Name);
    fxml.Active := True;
    fxml.ChildNodes['Package'].ChildNodes['Data'].ChildNodes['Picture'].ChildNodes['Pic1'].NodeValue := pic;
    fxml.SaveToFile(Folder + fileinfo.Name);
  except
    fxml.Free;
  end;
  if not FindFile.Threaded then
    Application.ProcessMessages;
end;

procedure TForm1.FindFileFolderChange(Sender: TObject;
  const Folder: string; var IgnoreFolder: TFolderIgnore);
begin
  Inc(Folders);
  if not FindFile.Threaded then
    Application.ProcessMessages;
end;

procedure TForm1.FindFileSearchAbort(Sender: TObject);
begin
  Update;
end;

procedure TForm1.FindFileSearchBegin(Sender: TObject);
begin
  SortedColumn := -1;
  Folders := 0;
  count := 0;
  StartTime := GetTickCount;
end;

procedure TForm1.FindFileSearchFinish(Sender: TObject);
begin
  stat1.SimpleText := Format('%d 目录 替换 %d 文件 - %.3f second(s)',
    [Folders, Count, (GetTickCount - StartTime) / 1000]);
  if FindFile.Aborted then
    stat1.SimpleText := '放弃更换 - ' + Stat1.SimpleText;
end;

procedure TForm1.suiFileListBox1DblClick(Sender: TObject);
var
  fxml: TXMLDocument;
  ts, ts2: TMemoryStream;
  jp: TJPEGImage;
  bp: TBitmap;
  pic, ss: string;
begin
  img1.Picture := nil;
  fxml := TXMLDocument.Create(self);
  ss := suifilelistbox1.FileName;
  fxml.LoadFromFile(ss);
  fxml.Active := True;
  ts := TMemoryStream.Create;
  ts2 := TMemoryStream.Create;
  try
    pic := fxml.ChildNodes['Package'].ChildNodes['Data'].ChildNodes['Picture'].ChildNodes['Pic1'].NodeValue;
  except
  end;
  if pic <> '' then
  begin
    ts.Clear;
    ts2.Clear;
    ts.Position := 0;
    ts2.Position := 0;
    ts.WriteBuffer(pic[1], Length(pic));
    ts.Position := 0;
    DecodeStream(ts, ts2);
    ts2.Position := 0;
    if ts2 <> nil then
    begin
      jp := TJPEGImage.Create;
      bp := TBitmap.Create;
      jp.LoadFromStream(ts2); ;
      bp.Assign(jp);
      img1.Stretch := True;
      img1.Picture.Assign(bp);
      jp.Free;
      bp.Free;
    end;
  end;
  fxml.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.Title := '图片更换程序';
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  FindFile.Abort;
end;

end.