D7DJyalu/样品/U_FileUp.pas
DESKTOP-E401PHE\Administrator b665aac497 ~
2025-07-22 14:29:40 +08:00

356 lines
9.5 KiB
ObjectPascal

unit U_FileUp;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, ComCtrls, ToolWin, ExtCtrls,
cxGridLevel, cxGridCustomTableView, cxGridTableView, cxGridDBTableView,
cxClasses, cxControls, cxGridCustomView, cxGrid, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdFTP, StdCtrls, ADODB,jpeg,
BtnEdit,IniFiles,strutils, cxLookAndFeels, cxLookAndFeelPainters,
cxNavigator;
type
TfrmFileUp = class(TForm)
cxGrid7: TcxGrid;
TV7: TcxGridDBTableView;
FileName: TcxGridDBColumn;
FileDate: TcxGridDBColumn;
cxGridLevel6: TcxGridLevel;
Panel16: TPanel;
ToolBar6: TToolBar;
FileUp: TToolButton;
FileDel: TToolButton;
Panel1: TPanel;
Label1: TLabel;
Code: TEdit;
ODPat: TOpenDialog;
IdFTP1: TIdFTP;
SaveDialog1: TSaveDialog;
ADOQueryFile: TADOQuery;
DataSource1: TDataSource;
ADOQueryCmd: TADOQuery;
ADOQueryTemp: TADOQuery;
Image2: TImage;
procedure FileUpClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FileDelClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
lstPat: TStringList;
AJpeg: TJPEGImage;
procedure CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer);
procedure SaveImageOther(FTFID:string);
procedure ReadINIFile10();
{ Private declarations }
public
CYID:String;
{ Public declarations }
end;
var
frmFileUp: TfrmFileUp;
implementation
uses
U_DataLink,U_Fun;
{$R *.dfm}
procedure TfrmFileUp.ReadINIFile10();
var
programIni:Tinifile; //配置文件名
FileName:string;
begin
FileName:=ExtractFilePath(Paramstr(0))+'SYSTEMSET.INI';
programIni:=Tinifile.create(FileName);
server:=programIni.ReadString('SERVER','服务器地址','127.0.0.1');
// server:=programIni.ReadString('SERVER','服务器地址',' 101.132.143.144');
programIni.Free;
end;
procedure TfrmFileUp.FileUpClick(Sender: TObject);
var
i,j: Integer;
PatFile: String;
FTPPath,FConNo,MaxNo:string;
AJpeg: TJPEGImage;
myStream: TADOBlobStream;
begin
if Trim(Code.Text)='' then
begin
Application.MessageBox('编号不能为空!','提示',0);
Exit;
end;
lstPat.Clear;
if ODPat.Execute then
begin
lstPat.AddStrings(ODPat.Files);
end;
if lstPat.Count > 0 then
begin
try
IdFTP1.Host :=PicSvr;//PicSvr;
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
except
IdFTP1.Quit;
Application.MessageBox('无法连接到文件服务器,请检查!', '提示', MB_ICONWARNING);
Exit;
end;
end;
Panel16.Visible:=True;
Panel16.Refresh;
try
AJpeg:=TJpegImage.Create();
ADOQueryCmd.Connection.BeginTrans;
for i:=0 to lstPat.Count - 1 do
begin
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select isnull(max(abs(cast(right(left(FileName,charindex(''.'',FileName)-1),2) as int))),0)+1 as BH from XD_File');
sql.Add('where CYID='''+trim(CYID)+''' ');
open;
end;
// PatFile:=Copy(ExtractFileName(lstPat[i]),(Pos('.',ExtractFileName(lstPat[i]))+1),(Length(ExtractFileName(lstPat[i]))-Pos('.',ExtractFileName(lstPat[i]))) ) ;
PatFile:=trim(Code.Text)+'-'+inttostr(ADOQueryTemp.fieldbyname('BH').AsInteger)+'.'+Copy(ExtractFileName(lstPat[i]),(Pos('.',ExtractFileName(lstPat[i]))+1),(Length(ExtractFileName(lstPat[i]))-Pos('.',ExtractFileName(lstPat[i]))) ) ;
AJpeg.LoadFromFile(ExtractFileName(lstPat[i]));
CreThumb(AJpeg,Image2,160, 120);
if IdFTP1.Connected then
begin
try
IdFTP1.Put(lstPat[i], Trim(UserDataFlag+'YP')+'\'+Trim(PatFile));
if GetLSNo(ADOQueryCmd,MaxNo,'YP','XD_File',4,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取图片最大号失败!','提示',0);
Exit;
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where 1<>1');
Open;
end;
with ADOQueryCmd do
begin
Append;
FieldByName('XFID').Value:=Trim(MaxNo);
FieldByName('CYID').Value:=Trim(CYID);
FieldByName('CYNO').Value:=Trim(Code.Text);
FieldByName('filename').Value:=Trim(PatFile);
FieldByName('FileDate').Value:=SGetServerDate(ADOQueryTemp);
fieldbyname('FileType').value:=Trim('YP');
Post;
end;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add(' select * from TP_File where TFID='''+Trim(MaxNo)+'''');
open;
end;
with ADOQueryCmd do
begin
if ADOQueryCmd.IsEmpty then
begin
Append;
FieldByName('Filler').Value:=Trim(DName);
end
else
begin
Edit;
FieldByName('Editer').Value:=Trim(DName);
FieldByName('EditTime').Value:=SGetServerDateTime(ADOQueryTemp);
end;
FieldByName('TFID').Value:=Trim(MaxNo);
FieldByName('WBID').Value:=Trim(CYID);
FieldByName('TFType').Value:='样品';
myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('FilesOther')), bmWrite);
AJpeg.Assign(Image2.Picture.Graphic);
AJpeg.SaveToStream(myStream);
myStream.Free;
Post;
end;
except
end;
end;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('Update CP_YDang Set TPFlag=1 where CYID='''+Trim(CYID)+'''');
ExecSQL;
end;
ADOQueryCmd.Connection.CommitTrans;
AJpeg.Free;
except
AJpeg.Free;
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('图片上传失败!','提示',0);
end;
if IdFTP1.Connected then IdFTP1.Quit;
with ADOQueryFile do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+'''');
open;
end;
{ with ADOQueryFile do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+'''');
SQL.Add(' and FileType=''YP''');
Open;
end;}
Panel16.Visible:=False;
if i>0 then
Application.MessageBox(PChar(inttostr(i)+'个文件上传成功!'),'提示',0);
ModalResult:=1;
end;
procedure TfrmFileUp.CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer);
var
Bitmap: TBitmap;
Ratio: Double;
ARect: TRect;
AHeight, AHeightOffset: Integer;
AWidth, AWidthOffset: Integer;
begin
Bitmap := TBitmap.Create;
try
Ratio := AJPeg.Width /AJPeg.Height;
if Ratio > 1.333 then
begin
AHeight := Round(Width / Ratio);
AHeightOffset := (Height - AHeight) div 2;
AWidth := Width;
AWidthOffset := 0;
end
else
begin
AWidth := Round(Height * Ratio);
AWidthOffset := (Width - AWidth) div 2;
AHeight := Height;
AHeightOffset := 0;
end;
Bitmap.Width := Width;
Bitmap.Height := Height;
Bitmap.Canvas.Brush.Color := clBtnFace;
Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
ARect := Rect(AWidthOffset, AHeightOffset, AWidth + AWidthOffset, AHeight + AHeightOffset);
Bitmap.Canvas.StretchDraw(ARect, AJPeg);
Image1.Picture.Assign(BitMap);
finally
Bitmap.Free;
end;
end;
procedure TfrmFileUp.SaveImageOther(FTFID:string);
var
AJpeg: TJPEGImage;
myStream: TADOBlobStream;
ImgMaxNo:String;
i,j: Integer;
PatFile: String;
FConNo,MaxNo:string;
begin
if Image2.Picture=nil then Exit;
AJpeg:=TJpegImage.Create();
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add(' select * from TP_File where TFID='''+Trim(FTFID)+'''');
open;
end;
with ADOQueryCmd do
begin
if Trim(FTFID)='' then
begin
Append;
FieldByName('Filler').Value:=Trim(DName);
end
else
begin
Edit;
FieldByName('Editer').Value:=Trim(DName);
FieldByName('EditTime').Value:=SGetServerDateTime(ADOQueryTemp);
end;
FieldByName('TFID').Value:=Trim(FTFID);
FieldByName('WBID').Value:=Trim(CYID);
FieldByName('TFType').Value:='样品';
AJpeg.Assign(Image2.Picture.Graphic);
myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('FilesOther')), bmWrite);
AJpeg.Assign(Image2.Picture.Graphic);
AJpeg.SaveToStream(myStream);
myStream.Free;
Post;
end;
end;
procedure TfrmFileUp.FormCreate(Sender: TObject);
begin
lstPat := TStringList.Create;
end;
procedure TfrmFileUp.FileDelClick(Sender: TObject);
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
SQL.Add(' Delete XD_File where XFID='''+Trim(ADOQueryFile.fieldbyname('XFID').AsString)+'''');
SQL.Add(' Delete TP_File where TFID='''+Trim(ADOQueryFile.fieldbyname('XFID').AsString)+'''');
ExecSQL;
end;
with ADOQueryFile do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+'''');
SQL.Add(' and FileType=''YP''');
open;
end;
if ADOQueryFile.IsEmpty then
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('Update CP_YDang Set TPFlag=0 where CYID='''+Trim(CYID)+'''');
ExecSQL;
end;
end;
end;
procedure TfrmFileUp.FormShow(Sender: TObject);
begin
with ADOQueryFile do
begin
Close;
SQL.Clear;
SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+'''');
SQL.Add(' and FileType=''YP''');
Open;
end;
end;
end.