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 + -
显示快捷键?