Ver 2,0,1,79

Hong-Dell\Hong

2024-05-14 bf489952e4fae3a5f891573614a6bbadc93d869f

 CB_IMGPSScanImp.pas

@@ -1,5 +1,5 @@
unit CB_IMGPSScanImp;
//PRO
//TEST
{$WARN SYMBOL_PLATFORM OFF}

interface
@@ -454,7 +454,8 @@
    FFtpIP : String;
    FFtpID : String;
    FFtpPwd : String;
    FFtpPath : String;
    FFtpRootPath : String;
    FFtpExtraPath : String;
    FFtpPort : Integer;
    FFtpProtocol : TFtpProtocol;
    //********Ftp參數*********
@@ -2803,7 +2804,7 @@
  SaveStreamB:TFileStream;
  cooom:integer;
Begin
  OpenDialog1.Filter := 'Image files|*.TIF;*.JPG';
  OpenDialog1.Filter := 'Image files|*.TIF;*.JPG;*.PNG';
  If OpenDialog1.Execute Then
  Begin
    ISB := TImageScrollBox.Create(self);
@@ -2998,16 +2999,19 @@
//ShowMessage(IntToStr(iGraphic.Palette.palNumEntries));
          if iGraphic.ImageFormat = ifBlackWhite then   //20200806 出現無法匯入,是因color256無法壓JPEG,待報會後再開啟
          begin
            SaveFilename := changefileext(SaveFilename,'.tif');    //20240320 Hong 調整黑白存tif
            iGraphic.Compression:=tcGroup4;
          end
          else if iGraphic.ImageFormat= ifColor256 then
          begin
            SaveFilename := changefileext(SaveFilename,'.jpg');    //20240320 Hong 調整Color256存jpg
            ConverttoGray(iGraphic);
            iGraphic.Compression:=tcJPEG;
            iGraphic.JpegQuality:=cooom;
          end
          else if (iGraphic.ImageFormat = ifTrueColor) or (iGraphic.ImageFormat = ifGray256) then
          begin
            SaveFilename := changefileext(SaveFilename,'.jpg');    //20240320 Hong 調整彩色灰階存jpg
            iGraphic.Compression:=tcJPEG;
            iGraphic.JpegQuality:=cooom;
          end
@@ -3035,8 +3039,7 @@
              SaveStream.Free;
            End;
          End
          Else If LowerCase(ExtractFileExt(SavePath + SaveFilename))
            = '.jpg' Then
          Else If LowerCase(ExtractFileExt(SavePath + SaveFilename)) = '.jpg' Then
          Begin
            If FileExists(SavePath + SaveFilename) Then
              DeleteFile(SavePath + SaveFilename);
@@ -3125,7 +3128,7 @@
              JpgGr := TJpegGraphic.Create;
              Try
                JpgGr.Assign(iGraphic);
                JpgGr.SaveQuality := 30;
                JpgGr.SaveQuality := cooom;
                // JpgGr.AppendToStream(SaveStream);
                JpgGr.SaveToFile(SavePath + SaveFilename);
              Finally
@@ -4370,7 +4373,7 @@
  SetFtpInfo;
  IIS_Ftp.FtpsConnect;

  IIS_Ftp.FtpsToMain(FFtpPath,NowCaseno+'.pdf','d:\1.pdf',display1);
  IIS_Ftp.FtpsToMain(FFtpExtraPath,NowCaseno+'.pdf','d:\1.pdf',display1);
end;

procedure TCB_IMGPSScanX.Button6Click(Sender: TObject);
@@ -6640,7 +6643,7 @@
      +'&must_formid='+must_formidStr  //擁有的 formid
      +'&last_add_formid='+last_add_formidstr   //當次新加的 formid
      +'&form_code='+ScanListStr      //scanlist.dat 表單代號
      +'&ftp_image_path='+FFtpPath   //加傳FTP目錄  HTTP上傳時會是空白
      +'&ftp_image_path='+FFtpExtraPath   //加傳FTP目錄  HTTP上傳時會是空白
      +'&in_doc1='+HTTPEncode(UTF8Encode(In_Doc1))
      +'&in_doc2='+HTTPEncode(UTF8Encode(In_Doc2));

@@ -6682,7 +6685,7 @@
           Result := False;
           Exit;
         end;
         if not IIS_Ftp.FtpsToMain(FFtpPath,CaseID+'.zip',Path+'Img.zip',display1) then
         if not IIS_Ftp.FtpsToMain(FFtpExtraPath,CaseID+'.zip',Path+'Img.zip',display1) then
         begin
           Showmessage(Format(_msg('上傳案件(%s)時,發生錯誤,錯誤原因:%s'),[CaseID,FtpErrStr]));
           Result := False;
@@ -6961,7 +6964,7 @@
        Result := False;
        Exit;
      end;
      if not IIS_Ftp.FtpsDownloadFile(IIS_Ftp.FtpPath,CaseID+'.zip',Path+CaseID+'.zip',display1) then
      if not IIS_Ftp.FtpsDownloadFile(FFtpExtraPath,CaseID+'.zip',Path+CaseID+'.zip',display1) then
      begin
        DownFileErrStr := Format(_Msg('錯誤原因:%s'),[FtpErrStr]);
        Result := False;
@@ -11022,14 +11025,15 @@
    Exit;
  end;
  TransMode := tsHttp;
  FFtpPath := '';
  FFtpExtraPath := '';

  if memo1.Lines.Strings[0] = '0' then
  begin
    if memo1.Lines.Strings[2] = 'Y' then
    if memo1.Lines.Strings[2] = 'Y' then   //要使用FTP
      TransMode := tsFtp;
    if memo1.Lines.Count > 3 then
    begin
      FFtpPath := memo1.Lines.Strings[3];
      FFtpExtraPath := memo1.Lines.Strings[3];
      DecodeFtpInfo(memo1.Lines.Strings[4]);
    end;
  end;
@@ -11044,7 +11048,7 @@
  IIS_Ftp.Ftpip := FFtpIP;
  IIS_Ftp.Ftpuserid := FFtpID;
  IIS_Ftp.FtpPwd := FFtpPwd;
  IIS_Ftp.FtpPath := FFtpPath;
  IIS_Ftp.FtpPath := FFtpRootPath;
  IIS_Ftp.FtpPort := FFtpPort;
  IIS_Ftp.FtpSSL := True;
  IIS_Ftp.FtpPassive := True;
@@ -14913,6 +14917,7 @@

  FMaxUploadSize:='10';
  FJpgCompression:=50;
  FFtpRootPath := '';  //影像平台沒有給FtpRoot目錄,會直接用FFtpExtraPath切換至指定目錄
  //FMode := 'DSCAN' ;
  //FIs_In_Wh := 'Y';
  if FIs_In_Wh = 'Y' then