unit_image_upload.pas

来自「美汇美容网网站管理系统」· PAS 代码 · 共 205 行

PAS
205
字号
unit Unit_Image_Upload;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, XPMenu, ComCtrls, ToolWin, ExtCtrls, Grids, StdCtrls, IniFiles,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP ,Unit_DM;

type
  TForm_Image_Upload = class(TForm)
    ControlBar1: TControlBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    XPMenu1: TXPMenu;
    ToolButton3: TToolButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    sg_Image: TStringGrid;
    IdFTP1: TIdFTP;
    Memo1: TMemo;
    procedure ToolButton2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
  private
    procedure ReadSetup;
    procedure ReadInfoImage;
    procedure ReadGoodsImage;
    { Private declarations }
  public
    { Public declarations }
    LocalDir,RemoteDir:String;
  end;

var
  Form_Image_Upload: TForm_Image_Upload;

implementation

{$R *.dfm}

procedure TForm_Image_Upload.ToolButton2Click(Sender: TObject);
begin
  Close;
end;

procedure TForm_Image_Upload.ReadSetup();
var
  meihuisetup:TIniFile;
begin
  meihuisetup := TIniFile.Create('meihui.ini');
  LocalDir:=meihuisetup.ReadString('Image Setup','LocalSaveDir','');
  RemoteDir:=meihuisetup.ReadString('Image Setup','RemoteSaveDir','');
  idFtp1.Host:=meihuisetup.ReadString('Ftp Setup','ServerIp','202.103.64.151');
  idFtp1.Port:=strtoint(meihuisetup.ReadString('Ftp Setup','ServerPort','21'));
  idFtp1.Username:=meihuisetup.ReadString('Ftp Setup','UserName','meihui');
  idFtp1.Password:=meihuisetup.ReadString('Ftp Setup','Password','');
  meihuisetup.Free;
end;

procedure TForm_Image_Upload.FormCreate(Sender: TObject);
begin
  Self.Left:= Round(Screen.Width/2-Width/2);
  Self.Top :=Round(Screen.Height/2-Height/2);

  Form_Image_Upload.ReadSetup();

  sg_image.Cells[0,0]:='操作';
  sg_image.Cells[1,0]:='需上传的图片';
  sg_image.Cells[2,0]:='上传目录';

  if not dm.adoc.Connected then
  begin
    try
      dm.adoc.Open();
    except
      application.MessageBox('连接数据库失败.'+#13+'请进入系统设置,设置ODBC.','提示',MB_OK);
      exit;
    end;
  end;
  Form_Image_Upload.ReadInfoImage;
  Form_Image_Upload.ReadGoodsImage;
end;


procedure TForm_Image_Upload.ReadInfoImage();
var
  i:integer;
begin
  with dm.adsInfo do
  begin
    close;
    commandtext:='select * from news_info where vImageType=''del'' or vImageType=''add''';
    open;

    if recordcount>0 then
    begin
      i:=sg_image.RowCount-sg_image.FixedRows;
      sg_image.RowCount:=sg_image.RowCount+recordcount;
      First;
      while not eof do
      begin
        sg_image.Cells[0,i]:=fieldvalues['vImageType'];
        sg_image.Cells[1,i]:=format('%s%s',[localdir,fieldvalues['vImage']]);
        sg_image.Cells[2,i]:=remoteDir;
        next;
        inc(i);
      end;
    end;
  end;
end;

procedure TForm_Image_Upload.ReadGoodsImage();
var
  i:integer;
begin
  with dm.adsComm do
  begin
    close;
    commandtext:='select * from goods where vImageType=''del'' or vImageType=''add''';
    open;

    if recordcount>0 then
    begin
      i:=sg_image.RowCount-sg_image.FixedRows;
      sg_image.RowCount:=sg_image.RowCount+recordcount;
      First;
      while not eof do
      begin
        sg_image.Cells[0,i]:=fieldvalues['vImageType'];
        sg_image.Cells[1,i]:=format('%s%s',[localdir,fieldvalues['vImage']]);
        sg_image.Cells[2,i]:=remoteDir;
        next;
        inc(i);
      end;
    end;
  end;
end;
procedure TForm_Image_Upload.ToolButton1Click(Sender: TObject);
var
  i:integer;
  tempdir:String;
begin
  if sg_image.RowCount>2 then
  begin
    toolbutton1.Enabled:=false;
    memo1.Lines.Clear;
    try
      idftp1.Connect();
      memo1.Lines.Add('[INFO] 连接FTP Server 成功.');
    except
      application.MessageBox('[INFO] 连接FTP Server 失败.','错误',MB_OK);
      exit;
    end;
    tempdir:='';
    memo1.Lines.Add('[INFO] 有'+inttostr(sg_image.RowCount-2)+'张图片需要处理.\n');
    memo1.Lines.Add('[INFO] 开始上传图片......');
    for i:=1 to sg_image.RowCount-2 do
    begin
      if tempdir<>sg_image.Cells[2,i] then
      begin
        idftp1.ChangeDir(sg_image.Cells[2,i]);
        memo1.Lines.Add('[INFO] 改变目录到'+sg_image.Cells[2,i]+'.');
      end;
      try
        if sg_image.Cells[0,i]='add' then
        begin
          idftp1.Put(sg_image.Cells[1,i],ExtractFileName(sg_image.Cells[1,i]));
          memo1.Lines.Add('[Info] 图片['+sg_image.Cells[1,i]+']上传成功.');
        end;
        if sg_image.Cells[0,i]='del' then
        begin
          idftp1.Delete(ExtractFileName(sg_image.Cells[1,i]));
          memo1.Lines.Add('[Info] 图片['+sg_image.Cells[1,i]+']删除成功.');
        end;
      except
          memo1.Lines.Add('[INFO] 图片['+sg_image.Cells[1,i]+']上传失败.');
      end;
    end;
    memo1.Lines.Add('[INFO] 图片上传完成.\n');
    memo1.Lines.Add('[INFO] 修改图片状态......');

    try
      with dm.adocm do
      begin
        CommandText:='update news_info set vImageType=''ok'' where vImageType=''add''';
        Execute;
        CommandText:='update news_info set vImageType=''no'',vImage='''' where vImageType=''del''';
        Execute;
        CommandText:='update goods set vImageType=''ok'' where vImageType=''add''';
        Execute;
        CommandText:='update goods set vImageType=''no'',,vImage='''' where vImageType=''del''';
        Execute;
      end;
    except
    end;

    memo1.Lines.Add('[INFO] 修改图片状态完成.\n');
    memo1.Lines.Add('[INFO] 所有操作全部完成.');
  end;
end;

end.

⌨️ 快捷键说明

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