D10myBiaoqi/A01基础公司管理/U_FtyFileUp.pas

unit U_FtyFileUp;

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, dxSkinsCore,
  dxSkinsDefaultPainters, dxDateRanges, IdExplicitTLSClientServerBase,
  Vcl.ExtDlgs, dxSkinWXI, dxScrollbarAnnotations, ShellAPI;

type
  TfrmFtyFileUp = 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;
    Image1: TImage;
    TV7Column1: TcxGridDBColumn;
    Label2: TLabel;
    HXName: TBtnEditC;
    procedure FileUpClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FileDelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure HXNameBtnUpClick(Sender: TObject);
    procedure HXNameBtnDnClick(Sender: TObject);
    procedure TV7CellDblClick(Sender: TcxCustomGridTableView;
      ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
      AShift: TShiftState; var AHandled: Boolean);
  private
    lstPat: TStringList;
    AJpeg: TJPEGImage;
    procedure CreThumb(Image1, Image2: TImage; Width, Height: Integer);
    procedure SaveImageOther(FTFID: string);
    procedure ReadINIFile10();
    procedure InitTP();
    { Private declarations }
  public
    FBCIID: string;
    FWidth, FHeight:Integer
    { Public declarations }
  end;

var
  frmFtyFileUp: TfrmFtyFileUp;

implementation

uses
  U_DataLink, U_RTFun, U_ZDYHelp;

{$R *.dfm} procedure TfrmFtyFileUp.InitTP();
begin
  with ADOQueryFile do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select TFID,WBID,TFDate,Files,Filler,FillTime,FileName,HXName from TP_File where WBID=''' + Trim(FBCIID) + '''');
    SQL.Add(' and FileType=''GYS''');
    Open;
  end;
end;

procedure TfrmFtyFileUp.ReadINIFile10();
var
  programIni: Tinifile;  //<2F><><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD>
  FileName: string;
begin
  FileName := ExtractFilePath(Paramstr(0)) + 'SYSTEMSET.INI';
  programIni := Tinifile.create(FileName);
  server := programIni.ReadString('SERVER', '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ַ', '127.0.0.1');
  programIni.Free;
end;

procedure TfrmFtyFileUp.FileUpClick(Sender: TObject);
var
  i, j, ii: Integer;
  PatFile: string;
  FTPPath, FConNo, MaxNo: string;
  AJpeg: TJPEGImage;
  myStream: TADOBlobStream;
  f: file of Byte;
  size: Longint;
  S: Double;
begin
  if Trim(Code.Text) = '' then
  begin
    Application.MessageBox('<27><><EFBFBD>Ų<EFBFBD><C5B2><EFBFBD>Ϊ<EFBFBD>գ<EFBFBD>', '<27><>ʾ', 0);
    Exit;
  end;
//  if Trim(HXName.Text) = '' then
//  begin
//    if Application.MessageBox('<27><><EFBFBD><EFBFBD>ȷ<EFBFBD><C8B7>Ϊ<EFBFBD><CEAA><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<27><>ʾ', 32 + 4) <> IDYES then
//      Exit;
//  end;

  lstPat.Clear;
  if ODPat.Execute then
  begin
    lstPat.AddStrings(ODPat.Files);
  end;
  if lstPat.Count > 0 then
  begin
    try
      IdFTP1.Host := PicSvr;
      IdFTP1.Username := 'three';
      IdFTP1.Password := '641010';
      IdFTP1.Connect();
    except
      IdFTP1.Quit;
      Application.MessageBox('<27>޷<EFBFBD><DEB7><EFBFBD><EFBFBD>ӵ<EFBFBD><D3B5>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>飡', '<27><>ʾ', MB_ICONWARNING);
      Exit;
    end;
  end;

  Panel16.Visible := True;
  Panel16.Refresh;

  try
    AJpeg := TJpegImage.Create();
    ADOQueryCmd.Connection.BeginTrans;
    ii := 0;
    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 TP_File');
        sql.Add('where FileType =''GYS'' and WBID=''' + trim(FBCIID) + ''' ');
        open;
      end;
      PatFile := trim(FBCIID) + '-' + inttostr(ADOQueryTemp.fieldbyname('BH').AsInteger) + '.' + Copy(ExtractFileName(lstPat[i]), (Pos('.', ExtractFileName(lstPat[i])) + 1), (Length(ExtractFileName(lstPat[i])) - Pos('.', ExtractFileName(lstPat[i]))));
      image1.Picture.LoadFromFile((lstPat[i]));
      CreThumb(Image1, Image2, FWidth, FHeight);



      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
            raise Exception.Create('ȡͼƬ<CDBC><C6AC><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>');

          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);
              FieldByName('TFDate').Value := SGetServerDateTime(ADOQueryTemp);
            end
            else
            begin
              Edit;
              FieldByName('Editer').Value := Trim(DName);
              FieldByName('EditTime').Value := SGetServerDateTime(ADOQueryTemp);
            end;
            FieldByName('TFID').Value := Trim(MaxNo);
            FieldByName('WBID').Value := Trim(FBCIID);
            FieldByName('TFType').Value := '<27><>Ӧ<EFBFBD><D3A6>';
            FieldByName('FileType').Value := 'GYS';
            FieldByName('HXName').Value := trim(HXName.Text);
            FieldByName('filename').Value := Trim(PatFile);
            myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('FilesOther')), bmWrite);
            AJpeg.Assign(Image2.Picture.Graphic);
            AJpeg.SaveToStream(myStream);
            myStream.Free;
            Post;
          end;
        except
          raise Exception.Create('<27>ϴ<EFBFBD>ͼƬʧ<C6AC>ܣ<EFBFBD>');
        end;
      end;
    end;

    ADOQueryCmd.Connection.CommitTrans;
    AJpeg.Free;
  except
    AJpeg.Free;
    ADOQueryCmd.Connection.RollbackTrans;
    Application.MessageBox('ͼƬ<CDBC>ϴ<EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ', 0);
  end;
  if IdFTP1.Connected then
    IdFTP1.Quit;
  InitTP();
  Panel16.Visible := False;

  if ii > 0 then
    Application.MessageBox(PChar(inttostr(ii) + '<27><><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD>2MB<4D><42><EFBFBD>ϴ<EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>'), '<27><>ʾ', 0);
  if i > 0 then
    Application.MessageBox(PChar(inttostr(i-ii) + '<27><><EFBFBD>ļ<EFBFBD><C4BC>ϴ<EFBFBD><CFB4>ɹ<EFBFBD><C9B9><EFBFBD>'), '<27><>ʾ', 0);

  ModalResult := 1;
end;

procedure TfrmFtyFileUp.CreThumb(Image1, Image2: TImage; Width, Height: Integer);
var
  Bitmap: TBitmap;
  Ratio: Double;
  ARect: TRect;
  AHeight, AHeightOffset: Integer;
  AWidth, AWidthOffset: Integer;
begin
  Bitmap := TBitmap.Create;
  try
    Ratio := Image1.Picture.Graphic.Width / Image1.Picture.Graphic.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, Image1.Picture.Graphic);
    Image2.Picture.Assign(Bitmap);
  finally
    Bitmap.Free;
  end;
end;

procedure TfrmFtyFileUp.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(FBCIID);
    FieldByName('TFType').Value := '<27><>Ʒ';
    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 TfrmFtyFileUp.TV7CellDblClick(Sender: TcxCustomGridTableView;
  ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
  AShift: TShiftState; var AHandled: Boolean);
var
  IdFTP1: TIdFTP;
  FPath, FFName, FileName: string;
  FInt: integer;
begin
  FileName := ADOQueryFile.FieldByName('FileName').AsString;
  try
    IdFTP1 := TIdFTP.Create(self);
    IdFTP1.Host := PicSvr;
    IdFTP1.Username := 'three';
    IdFTP1.Password := '641010';
    IdFTP1.Connect();
  except
    IdFTP1.Quit;
    IdFTP1.Free;
    Application.MessageBox('<27>޷<EFBFBD><DEB7><EFBFBD><EFBFBD>ӵ<EFBFBD><D3B5>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>飡', '<27><>ʾ', MB_ICONWARNING);
    Exit;
  end;
  FPath := 'D:\Right1209\';
  if not DirectoryExists(ExtractFileDir(FPath)) then
    CreateDir(ExtractFileDir(FPath));
  FFName := Trim(FileName);
  FFName := FPath + FFName;
  if FileExists(FFName) then
  begin
    FInt := 1;
  end;
  if FInt <> 1 then
    IdFTP1.Get(UserDataFlag + 'YP\' + FileName, pchar(FFName));
  if IdFTP1.Connected then
  begin
    IdFTP1.Quit;
    IdFTP1.Free;
  end;
  ShellExecute(Handle, 'open', PChar(FFName), '', '', SW_SHOWNORMAL);

end;

procedure TfrmFtyFileUp.FormCreate(Sender: TObject);
begin
  lstPat := TStringList.Create;
  if FWidth = 0 then
    FWidth := 160;
  if FHeight = 0 then
    FHeight := 120;
end;

procedure TfrmFtyFileUp.FileDelClick(Sender: TObject);
begin
  with ADOQueryCmd do
  begin
    Close;
    sql.Clear;
    SQL.Add(' Delete TP_File where TFID=''' + Trim(ADOQueryFile.fieldbyname('TFID').AsString) + '''');
    ExecSQL;
  end;

  with ADOQueryFile do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select TFID,WBID,TFDate,Files,Filler,FillTime,FileName from TP_File where WBID=''' + Trim(FBCIID) + '''');
    SQL.Add(' and FileType=''GYS''');
    Open;
  end;
//  if ADOQueryFile.IsEmpty then
//  begin
//    with ADOQueryCmd do
//    begin
//      Close;
//      sql.Clear;
//      sql.Add('Update CP_YDang Set TPFlag=0 where FBCIID=''' + Trim(FBCIID) + '''');
//      ExecSQL;
//    end;
//  end;
end;

procedure TfrmFtyFileUp.FormShow(Sender: TObject);
begin
  with ADOQueryFile do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select TFID,WBID,TFDate,Files,Filler,FillTime,FileName from TP_File where WBID=''' + Trim(FBCIID) + '''');
    SQL.Add(' and FileType=''GYS''');
    Open;
  end;
end;

procedure TfrmFtyFileUp.HXNameBtnDnClick(Sender: TObject);
begin
  TBtnEditC(Sender).Text := '';
  TBtnEditC(Sender).TxtCode := '';
end;

procedure TfrmFtyFileUp.HXNameBtnUpClick(Sender: TObject);
begin
  try
    frmZDYHelp := TfrmZDYHelp.Create(Application);
    with frmZDYHelp do
    begin
      flag := 'HX' + Trim(Code.Text);
      flagname := '<27><><EFBFBD><EFBFBD>';
      if ShowModal = 1 then
      begin
        TEdit(Sender).Text := Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
      end;
    end;
  finally
    frmZDYHelp.Free;
  end;
end;

end.