Ignore:
Timestamp:
Mar 31, 2010, 5:06:56 PM (14 years ago)
Author:
Kevin Toppenberg
Message:

Added functions to Templates, and Images tab

File:
1 edited

Legend:

Unmodified
Added
Removed

  • cprs/branches/tmg-cprs/CPRS-Chart/fImages.pas

    r612 r729  
    6464    ThumbsImageList: TImageList;
    6565    CurrentNoteMemo: TMemo;
    66     Panel1: TPanel;
    67     Splitter1: TSplitter;
     66    pnlTop: TPanel;
     67    HorizSplitter: TSplitter;
    6868    Splitter2: TSplitter;
    6969    UploadImagesButton: TBitBtn;
    … …  
    7373    MemosPanel: TPanel;
    7474    UploadImagesMnuAction: TMenuItem;
    75     Panel2: TPanel;
     75    pnlBottom: TPanel;
    7676    TabControl: TTabControl;
    7777    WebBrowser: TWebBrowser;
     78    AutoScanUpload: TMenuItem;
     79    PickScanFolder: TMenuItem;
     80    OpenDialog: TOpenDialog;
    7881    procedure mnuChartTabClick(Sender: TObject);
    7982    procedure mnuActNewClick(Sender: TObject);
    … …  
    8992      var ImageIndex: Integer);
    9093    procedure TabControlResize(Sender: TObject);
     94    procedure EnableAutoScanUploadClick(Sender: TObject);
     95    procedure PickScanFolderClick(Sender: TObject);
    9196  private
    9297    ImageInfoList : TList;
    … …  
    9499    CurImageToLoad : integer;
    95100    InTimerFn : Boolean;
     101    DropBoxDir : string;
     102    UseDropBox : boolean;
    96103    procedure EnsureImageListLoaded();
    97104    procedure ClearImageList();
    … …  
    102109    procedure UpdateNoteInfoMemo();
    103110    procedure UpdateImageInfoMemo(Rec: TImageInfo);
     111    function FileSize(fileName : wideString) : Int64;
    104112  public
    105113    CacheDir : AnsiString;
    … …  
    107115    function Decode(input: AnsiString) : AnsiString;
    108116    function Encode(input: AnsiString) : AnsiString;
    109     function DownloadFile(FPath,FName,LocalSaveFNamePath: AnsiString): boolean;
    110     function UploadFile(LocalFNamePath,FPath,FName: AnsiString): boolean;
     117    function DownloadFileViaDropbox(FPath,FName,LocalSaveFNamePath: AnsiString;CurrentImage,TotalImages: Integer): boolean;
     118    function DownloadFile(FPath,FName,LocalSaveFNamePath: AnsiString;CurrentImage,TotalImages: Integer): boolean;
     119    function UploadFileViaDropBox(LocalFNamePath,FPath,FName: AnsiString;CurrentImage,TotalImages: Integer): boolean;
     120    function UploadFile(LocalFNamePath,FPath,FName: AnsiString;CurrentImage,TotalImages: Integer): boolean;
    111121    procedure SplitLinuxFilePath(FullPathName : AnsiString;
    112122                                 var Path : AnsiString;
    … …  
    114124    procedure GetImageList();
    115125    procedure NewNoteSelected(EditIsActive : boolean);
     126    function CreateBarcode(MsgStr: AnsiString; ImageType: AnsiString): AnsiString;
     127    function DecodeBarcode(LocalFNamePath,ImageType: AnsiString): AnsiString;
    116128  published
    117129  end;
    … …  
    134146     mshtml,  {//kt added 5-2-05}
    135147     UploadImages, {//kt added 9/25/05}
    136      UPloadProgress, {//kt 10-1-05}
    137      rHTMLTools, fNotes;  {//kt added 5-27-05 for IsHTMLDocument}
     148     //ImageTransferForm, {//kt 10-1-05}
     149     uTMGOptions,  //kt 3/10/10
     150     rHTMLTools, fNotes, frmImageTransferProgress;  {//kt added 5-27-05 for IsHTMLDocument}
    138151
    139152
    … …  
    146159    if CurImageToLoad <> -1 then begin //-1 means RPC-> no avail images.
    147160      if CurImageToLoad < ImageInfoList.Count then begin
     161        ImageTransferForm.ProgressMsg.Caption := 'Downloading Images';
     162        //if ImageTransferForm.Visible = false then begin
     163        //   ImageTransferForm.Show;
     164        //end;
    148165        DownloadToCache(CurImageToLoad); //Only load 1 image per timer firing.
    149166        SetupTab(CurImageToLoad);
    … …  
    153170      end else begin
    154171        timLoadImages.Enabled := false;
     172        //ImageTransferForm.ProgressBar.Position := 100;
     173        //Sleep(1000);
     174        //ImageTransferForm.Hide;
    155175      end;
    156176    end;
    … …  
    193213  NullImageName := ExtractFilePath(ParamStr(0)) + 'images\blank.htm';
    194214  if not DirectoryExists(CacheDir) then ForceDirectories(CacheDir);
     215
     216  UseDropBox := uTMGOptions.ReadBool('Use dropbox directory for transfers',false);
     217  DropBoxDir := uTMGOptions.ReadString('Dropbox directory','??');
     218  if DropBoxDir='??' then begin  //just on first run.
     219    uTMGOptions.WriteBool('Use dropbox directory for transfers',false);
     220    uTMGOptions.WriteString('Dropbox directory','');
     221  end;
     222  AutoScanUpload.Checked := uTMGOptions.ReadBool('Scan Enabled',false);
    195223end;
    196224
    … …  
    206234var
    207235  TIUIEN : AnsiString;
    208 
     236                                                         
    209237begin
    210238  inherited;
    … …  
    396424  try
    397425    TIUIEN := IntToStr(frmNotes.lstNotes.ItemID);
    398     StatusText('Retrieving images information...');
    399     CallV('MAG3 CPRS TIU NOTE', [TIUIEN]);
    400     for i:=0 to (RPCBrokerV.Results.Count-1) do begin
    401       s :=RPCBrokerV.Results[i];
    402       if i=0 then begin
    403         if piece(s,'^',1)='0' then break //i.e. abort due to error signal
    404         else continue;   //ignore rest of header (record #0)
    405       end;
    406       Rec := TImageInfo.Create; // ImageInfoList will own this.
    407       Rec.LongDesc := nil;
    408       Rec.TabIndex := -1;
    409       Rec.TabImageIndex := 0;
    410       s2 := piece(s,'^',2); if s2='' then s2 := '0'; //IEN
    411       Rec.IEN := StrToInt(s2);
    412       ImageFPathName := piece(s,'^',3);       //Image FullPath and name
    413       ThumbnailFPathName := piece(s,'^',4);   //Abstract FullPath and Name
    414       Rec.ShortDesc := piece(s,'^',5);            //SHORT DESCRIPTION field
    415       s2 := piece(s,'^',6); if s2='' then s2 := '0'; //PROCEDURE/ EXAM DATE/TIME field
    416       Rec.DateTime := s2;
    417       s2 := piece(s,'^',7); if s2='' then s2 := '0';  //OBJECT TYPE
    418       Rec.ImageType := StrToInt(s2);
    419       Rec.ProcName := piece(s,'^',8);                 //PROCEDURE field
    420       Rec.DisplayDate := piece(s,'^',9);              //Procedure Date in Display format
    421       s2 := piece(s,'^',10); if s2='' then s2 := '0'; //PARENT DATA FILE image pointer
    422       Rec.ParentDataFileIEN := StrToInt(s2);
    423       Rec.AbsType := piece(s,'^',11)[1];              //the ABSTYPE :  'M' magnetic 'W' worm  'O' offline
    424       Rec.Accessibility := piece(s,'^',12)[1];        //Image accessibility   'A' accessable  or  'O' offline
    425       s2 := piece(s,'^',13); if s2='' then s2 := '0'; //Dicom Series number
    426       Rec.DicomSeriesNum := StrToInt(s2);
    427       s2 := piece(s,'^',14); if s2='' then s2 := '0'; //Dicom Image Number
    428       Rec.DicomImageNum := StrToInt(s2);
    429       s2 := piece(s,'^',15); if s2='' then s2 := '0'; //Count of images in the group, or 1 if a single image
    430       Rec.GroupCount := StrToInt(s2);
    431 
    432       SplitLinuxFilePath(ImageFPathName,ServerPathName,ServerFName);
    433       Rec.ServerPathName := ServerPathName;
    434       Rec.ServerFName := ServerFName;
    435       Rec.CacheFName := CacheDir + '\' + ServerFName;
    436       SplitLinuxFilePath(ThumbnailFPathName,ServerPathName,ServerFName);
    437       Rec.ServerThumbPathName := ServerPathName;
    438       Rec.ServerThumbFName := ServerFName;
    439       Rec.CacheThumbFName := CacheDir + '\' + ServerFName;
    440       ImageInfoList.Add(Rec);  // ImageInfoList will own Rec.
    441     end;
    442     for i:= 0 to ImageInfoList.Count-1 do begin
    443       Rec := TImageInfo(ImageInfoList.Items[i]);
    444       ImageIEN := Rec.IEN;
    445       CallV('TMG GET IMAGE LONG DESCRIPTION', [ImageIEN]);
    446       for j:=0 to (RPCBrokerV.Results.Count-1) do begin
    447         if (j>0) then begin
    448           if Rec.LongDesc = nil then Rec.LongDesc := TStringList.Create;
    449           Rec.LongDesc.Add(RPCBrokerV.Results.Strings[j]);
    450         end else begin
    451           if RPCBrokerV.Results[j]='' then break;
    452         end;
    453       end;
    454     end;
     426
    455427  except
    456428    //Error occurs after note is signed, and frmNotes.lstNotes.ItemID is "inaccessible"
    457429    on E: Exception do exit;
    458430  end;
     431  //----MOVED
     432  StatusText('Retrieving images information...');
     433  CallV('MAG3 CPRS TIU NOTE', [TIUIEN]);
     434  for i:=0 to (RPCBrokerV.Results.Count-1) do begin
     435    s :=RPCBrokerV.Results[i];
     436    if i=0 then begin
     437      if piece(s,'^',1)='0' then break //i.e. abort due to error signal
     438      else continue;   //ignore rest of header (record #0)
     439    end;
     440    if Pos('-1~',s)>0 then continue;  //abort if error signal.
     441    Rec := TImageInfo.Create; // ImageInfoList will own this.
     442    Rec.LongDesc := nil;
     443    Rec.TabIndex := -1;
     444    Rec.TabImageIndex := 0;
     445    s2 := piece(s,'^',2); if s2='' then s2 := '0'; //IEN
     446    Rec.IEN := StrToInt(s2);
     447    ImageFPathName := piece(s,'^',3);       //Image FullPath and name
     448    ThumbnailFPathName := piece(s,'^',4);   //Abstract FullPath and Name
     449    Rec.ShortDesc := piece(s,'^',5);            //SHORT DESCRIPTION field
     450    s2 := piece(s,'^',6); if s2='' then s2 := '0'; //PROCEDURE/ EXAM DATE/TIME field
     451    Rec.DateTime := s2;
     452    s2 := piece(s,'^',7); if s2='' then s2 := '0';  //OBJECT TYPE
     453    Rec.ImageType := StrToInt(s2);
     454    Rec.ProcName := piece(s,'^',8);                 //PROCEDURE field
     455    Rec.DisplayDate := piece(s,'^',9);              //Procedure Date in Display format
     456    s2 := piece(s,'^',10); if s2='' then s2 := '0'; //PARENT DATA FILE image pointer
     457    Rec.ParentDataFileIEN := StrToInt(s2);
     458    Rec.AbsType := piece(s,'^',11)[1];              //the ABSTYPE :  'M' magnetic 'W' worm  'O' offline
     459    s2 := piece(s,'^',12); if s2='' then s2 :='O';
     460    Rec.Accessibility := s2[1];                     //Image accessibility   'A' accessable  or  'O' offline
     461    s2 := piece(s,'^',13); if s2='' then s2 := '0'; //Dicom Series number
     462    Rec.DicomSeriesNum := StrToInt(s2);
     463    s2 := piece(s,'^',14); if s2='' then s2 := '0'; //Dicom Image Number
     464    Rec.DicomImageNum := StrToInt(s2);
     465    s2 := piece(s,'^',15); if s2='' then s2 := '0'; //Count of images in the group, or 1 if a single image
     466    Rec.GroupCount := StrToInt(s2);
     467
     468    SplitLinuxFilePath(ImageFPathName,ServerPathName,ServerFName);
     469    Rec.ServerPathName := ServerPathName;
     470    Rec.ServerFName := ServerFName;
     471    Rec.CacheFName := CacheDir + '\' + ServerFName;
     472    SplitLinuxFilePath(ThumbnailFPathName,ServerPathName,ServerFName);
     473    Rec.ServerThumbPathName := ServerPathName;
     474    Rec.ServerThumbFName := ServerFName;
     475    Rec.CacheThumbFName := CacheDir + '\' + ServerFName;
     476    ImageInfoList.Add(Rec);  // ImageInfoList will own Rec.
     477  end;
     478  for i:= 0 to ImageInfoList.Count-1 do begin
     479    Rec := TImageInfo(ImageInfoList.Items[i]);
     480    ImageIEN := Rec.IEN;
     481    CallV('TMG GET IMAGE LONG DESCRIPTION', [ImageIEN]);
     482    for j:=0 to (RPCBrokerV.Results.Count-1) do begin
     483      if (j>0) then begin
     484        if Rec.LongDesc = nil then Rec.LongDesc := TStringList.Create;
     485        Rec.LongDesc.Add(RPCBrokerV.Results.Strings[j]);
     486      end else begin
     487        if RPCBrokerV.Results[j]='' then break;
     488      end;
     489    end;
     490  end;
     491   //----END MOVED
    459492  StatusText('');
    460493end;
    … …  
    473506  ServerPathName := Rec.ServerPathName;
    474507  if not FileExists(Rec.CacheFName) then begin
    475     DownloadFile(ServerPathName,ServerFName,Rec.CacheFName);
     508    DownloadFile(ServerPathName,ServerFName,Rec.CacheFName,(ImageIndex*2)-1,ImageInfoList.Count*2);
    476509  end;
    477510  ServerFName := Rec.ServerThumbFName;
    478511  ServerPathName := Rec.ServerThumbPathName;
    479512  if not FileExists(Rec.CacheThumbFName) then begin
    480     DownloadFile(ServerPathName,ServerFName,Rec.CacheThumbFName);
     513    DownloadFile(ServerPathName,ServerFName,Rec.CacheThumbFName,ImageIndex*2,ImageInfoList.Count*2);
    481514  end;
    482515  Application.ProcessMessages;
    … …  
    502535
    503536
    504 function TfrmImages.UploadFile(LocalFNamePath,FPath,FName: AnsiString): boolean;
     537function TfrmImages.UploadFileViaDropBox(LocalFNamePath,FPath,FName: AnsiString;CurrentImage,TotalImages: Integer): boolean;
     538var
     539  DropboxFile : AnsiString;
     540begin
     541  //First copy LocalFileNamePath --> DropBox\FileName
     542  DropboxFile := ExcludeTrailingBackslash(DropboxDir) + '\' + FName;
     543  if CopyFile(pchar(LocalFNamePath),pchar(DropboxFile),false)=false then begin
     544    MessageDlg('Dropbox file transfer failed.  Code='+InttoStr(GetLastError),
     545               mtError,[mbOK],0);
     546    result := false;
     547    exit;
     548  end;
     549
     550  // CallV('TMG UPLOAD FILE DROPBOX', ...);
     551  RPCBrokerV.ClearParameters := true;
     552  RPCBrokerV.remoteprocedure := 'TMG UPLOAD FILE DROPBOX';
     553  RPCBrokerV.param[0].PType := literal;
     554  RPCBrokerV.param[0].Value := FPath;
     555  RPCBrokerV.Param[1].PType := literal;
     556  RPCBrokerV.Param[1].Value := FName;
     557  RPCBrokerV.Param[2].PType := literal;
     558  RPCBrokerV.Param[2].Value := '1'; //see comments in UploadFile re '1' hardcoding
     559
     560  RPCBrokerV.Call;  //Move file into dropbox.
     561  Result := (Piece(RPCBrokerV.Results[0],'^',1)='1');  //1=success, 0=failure
     562end;
     563
     564
     565function TfrmImages.UploadFile(LocalFNamePath,FPath,FName: AnsiString;CurrentImage,TotalImages: Integer): boolean;
    505566const
    506567  RefreshInterval = 500;
    … …  
    523584  result := false;  //default of failure
    524585  if not FileExists(LocalFNamePath) then exit;
     586  if UseDropBox then begin
     587    Result := UploadFileViaDropBox(LocalFNamePath,FPath,FName,CurrentImage,TotalImages);
     588    exit;
     589  end;
    525590  try
    526591    InFile := TFileStream.Create(LocalFNamePath,fmOpenRead or fmShareCompat);
    … …  
    529594    // the RPC call, and I can't make a progress bar change during that...
    530595    // (or I could, but I'm not going to change the RPC broker...)
    531     UploadProgressForm.setMax(InFile.Size);
    532     //UploadProgressForm.ResetStartTime;
    533     UploadProgressForm.ProgressMsg.Caption := 'Prepairing to upload...';
    534     UploadProgressForm.Show;
     596    ImageTransferForm.setMax(InFile.Size);
     597    //ImageTransferForm.ResetStartTime;
     598    ImageTransferForm.ProgressMsg.Caption := 'Preparing to upload...';
     599    ImageTransferForm.Show;
    535600    totalReadCount := 0;
    536601  except
    … …  
    567632    LocalOutFile.Write(Buffer,ReadCount); //for local copy
    568633    totalReadCount := totalReadCount + ReadCount;
    569     UploadProgressForm.updateProgress(totalReadCount);
     634    ImageTransferForm.updateProgress(totalReadCount);
    570635    OneLine := '';
    571636    if ReadCount > 0 then begin
    … …  
    588653  SavedCursor := Screen.Cursor;
    589654  Screen.Cursor := crHourGlass;
    590   UploadProgressForm.ProgressMsg.Caption := 'Uploading file to server...';
     655  ImageTransferForm.ProgressMsg.Caption := 'Uploading file to server...';
    591656  Application.ProcessMessages;
    592657
    … …  
    595660  RPCResult := RPCBrokerV.Results[0];
    596661  result := (Piece(RPCResult,'^',1)='1');
    597   UploadProgressForm.Hide;
     662  ImageTransferForm.Hide;
    598663  if result=false then begin
    599664    Application.MessageBox('Error uploading file','Error');
    … …  
    606671
    607672
    608 function TfrmImages.DownloadFile(FPath,FName,LocalSaveFNamePath: AnsiString): boolean;
     673function TfrmImages.DownloadFileViaDropbox(FPath,FName,LocalSaveFNamePath: AnsiString;CurrentImage,TotalImages: Integer): boolean;
     674var
     675  DropboxFile : AnsiString;
     676  CurrentFileSize : Integer;
     677begin
     678  // CallV('TMG DOWNLOAD FILE DROPBOX', ...);
     679  RPCBrokerV.ClearParameters := true;
     680  RPCBrokerV.remoteprocedure := 'TMG DOWNLOAD FILE DROPBOX';
     681  RPCBrokerV.param[0].PType := literal;
     682  RPCBrokerV.param[0].Value := FPath;
     683  RPCBrokerV.Param[1].PType := literal;
     684  RPCBrokerV.Param[1].Value := FName;
     685  RPCBrokerV.Param[2].PType := literal;
     686  RPCBrokerV.Param[2].Value := '1'; //see comments in UploadFile re '1' hardcoding
     687
     688  RPCBrokerV.Call;  //Move file into dropbox.
     689  Result := (Piece(RPCBrokerV.Results[0],'^',1)='1');  //1=success, 0=failure
     690  CurrentFileSize := strtoint(Piece(RPCBrokerV.Results[0],'^',3));  //Piece 3 = file size
     691
     692  if Result=true then begin
     693    DropboxFile := ExcludeTrailingBackslash(DropboxDir) + '\' + FName;
     694    if ImageTransferForm.visible = False then ImageTransferForm.show;
     695    while FileSize(DropboxFile) <> CurrentFileSize do sleep(1000);   //elh
     696    ImageTransferForm.ProgressBar.Max := TotalImages;                //elh
     697    ImageTransferForm.ProgressBar.Position := CurrentImage+2;          //elh
     698    if TotalImages = (CurrentImage+2) then begin
     699       Sleep(1000);
     700       ImageTransferForm.hide;
     701    end;
     702    //Now move DropBox\FileName --> LocalFileNamePath
     703    if MoveFile(pchar(DropboxFile),pchar(LocalSaveFNamePath))=false then begin
     704      MessageDlg('Dropbox file transfer failed.  Code='+InttoStr(GetLastError),
     705                 mtError,[mbOK],0);
     706    end;
     707  end;
     708end;
     709
     710
     711function TfrmImages.DownloadFile(FPath,FName,LocalSaveFNamePath: AnsiString;CurrentImage,TotalImages: Integer): boolean;
    609712var
    610713  i,count                       : integer;
    … …  
    621724  if FileExists(LocalSaveFNamePath) then begin
    622725    DeleteFile(LocalSaveFNamePath);
     726  end;
     727  if UseDropBox then begin
     728    Result := DownloadFileViaDropBox(FPath,FName,LocalSaveFNamePath,CurrentImage,TotalImages);
     729    exit;
    623730  end;
    624731  Result := true; //default to success;
    … …  
    9161023end;
    9171024
     1025function TfrmImages.CreateBarcode(MsgStr: AnsiString; ImageType: AnsiString): AnsiString;
     1026//Create a local barcode file, in .png format, from MsgStr
     1027//ImageType is optional, default ='png'.  It should NOT contain '.'
     1028//Returns file path on local client of new barcode image.
     1029//Note: this function is not related to uploading or downloading images
     1030//      to the server for attaching to progress notes.  It is included
     1031//      in this unit because the functionality used is nearly identical to
     1032//      the other code.
     1033  function UniqueFName : AnsiString;
     1034    var  FName,tempFName : AnsiString;
     1035         count : integer;
     1036  begin
     1037    FName := 'Barcode-Image';
     1038    count := 0;
     1039    repeat
     1040      tempFName := CacheDir + '\' + FName + '.' + ImageType;
     1041      FName := FName + '1';
     1042      count := count+1;
     1043    until (fileExists(tempFName)=false) or (count> 32);
     1044    result := tempFName;
     1045  end;
     1046
     1047var
     1048  i,count                       : integer;
     1049  j                             : word;
     1050  OutFile                       : TFileStream;
     1051  s                             : AnsiString;
     1052  Buffer                        : array[0..1024] of byte;
     1053  LocalSaveFNamePath            : AnsiString;
     1054
     1055begin
     1056  StatusText('Getting Barcode...');
     1057  LocalSaveFNamePath := UniqueFName;
     1058  Result := LocalSaveFNamePath;  //default to success;
     1059
     1060  // CallV('TMG BARCODE ENCODE', [MsgStr]);
     1061  RPCBrokerV.ClearParameters := true;
     1062  RPCBrokerV.remoteprocedure := 'TMG BARCODE ENCODE';
     1063  RPCBrokerV.param[0].Value := MsgStr;
     1064  RPCBrokerV.param[0].PType := literal;
     1065  RPCBrokerV.Param[1].Value := '.X';  //<-- is this needed or used?
     1066  RPCBrokerV.Param[1].PType := list;
     1067  RPCBrokerV.Param[1].Mult['"IMAGE TYPE"'] := ImageType;
     1068  RPCBrokerV.Call;
     1069
     1070  Application.ProcessMessages;
     1071  //Note:RPCBrokerV.Results[0]=1 if successful load, =0 if failure
     1072  if (RPCBrokerV.Results.Count>0) and (RPCBrokerV.Results[0]='1') then begin
     1073    OutFile := TFileStream.Create(LocalSaveFNamePath,fmCreate);
     1074    for i:=1 to (RPCBrokerV.Results.Count-1) do begin
     1075      s :=Decode(RPCBrokerV.Results[i]);
     1076      count := Length(s);
     1077      if count>1024 then begin
     1078        Result := ''; //failure of load.
     1079        break;
     1080      end;
     1081      for j := 1 to count do Buffer[j-1] := ord(s[j]);
     1082      OutFile.Write(Buffer,count);
     1083    end;
     1084    OutFile.Free;
     1085  end else begin
     1086    result := '';
     1087  end;
     1088  StatusText('');
     1089end;
     1090
     1091
     1092function TfrmImages.DecodeBarcode(LocalFNamePath,ImageType: AnsiString): AnsiString;
     1093//Decode data from barcode on image, or return '' if none
     1094//Note: if I could find a cost-effective way of decoding this on client side,
     1095//      then that code be done here in the function, instead of uploading image
     1096//      to the server for decoding.
     1097const
     1098  RefreshInterval = 500;
     1099  BlockSize = 512;
     1100
     1101var
     1102  ReadCount                     : Word;
     1103  ParamIndex                    : LongWord;
     1104  j                             : word;
     1105  InFile                        : TFileStream;
     1106  Buffer                        : array[0..1024] of byte;
     1107  RefreshCountdown              : integer;
     1108  OneLine                       : AnsiString;
     1109  RPCResult                     : AnsiString;
     1110  SavedCursor                   : TCursor;
     1111  totalReadCount                : integer;
     1112begin
     1113  result := '';  //default of failure
     1114  if not FileExists(LocalFNamePath) then exit;
     1115  try
     1116    InFile := TFileStream.Create(LocalFNamePath,fmOpenRead or fmShareCompat);
     1117    //Note: I may well cut this out.  Most of the delay occurs during
     1118    // the RPC call, and I can't make a progress bar change during that...
     1119    // (or I could, but I'm not going to change the RPC broker...)
     1120    ImageTransferForm.setMax(InFile.Size);
     1121    //ImageTransferForm.ResetStartTime;
     1122    ImageTransferForm.ProgressMsg.Caption := 'Preparing to upload...';
     1123    ImageTransferForm.Show;
     1124    totalReadCount := 0;
     1125  except
     1126    // catch failure here...  on eError...
     1127    exit;
     1128  end;
     1129
     1130  StatusText('Checking image for barcodes...');
     1131  Application.ProcessMessages;
     1132
     1133  RPCBrokerV.ClearParameters := true;
     1134  RPCBrokerV.Param.Clear;
     1135  RPCBrokerV.Param[0].PType := list;
     1136  ParamIndex := 0;
     1137  RefreshCountdown := RefreshInterval;
     1138  //Put image data into parameter 0 (ARRAY parameter of RPC on server side)
     1139  repeat
     1140    ReadCount := InFile.Read(Buffer,BlockSize);
     1141    OneLine := '';
     1142    totalReadCount := totalReadCount + ReadCount;
     1143    ImageTransferForm.updateProgress(totalReadCount);
     1144    if ReadCount > 0 then begin
     1145      SetLength(OneLine,ReadCount);
     1146      for j := 1 to ReadCount do OneLine[j] := char(Buffer[j-1]);
     1147      RPCBrokerV.Param[0].Mult[IntToStr(ParamIndex)] := Encode(OneLine);
     1148      Inc(ParamIndex);
     1149      Dec(RefreshCountdown);
     1150      if RefreshCountdown < 1 then begin
     1151        Application.ProcessMessages;
     1152        RefreshCountdown := RefreshInterval;
     1153      end;
     1154    end;
     1155  until (ReadCount < BlockSize);
     1156  RPCBrokerV.Param[1].PType := literal;
     1157  RPCBrokerV.Param[1].Value := ImageType;
     1158
     1159  RPCBrokerV.remoteprocedure := 'TMG BARCODE DECODE';
     1160
     1161  SavedCursor := Screen.Cursor;
     1162  Screen.Cursor := crHourGlass;
     1163  ImageTransferForm.ProgressMsg.Caption := 'Uploading file to server...';
     1164  Application.ProcessMessages;
     1165
     1166  CallBroker;  //this is the slow step, pass to server and get response.
     1167
     1168  Screen.Cursor := SavedCursor;
     1169  ImageTransferForm.Hide;
     1170  //Get result: 1^DecodedMessage, or 0^Error Message
     1171  RPCResult := RPCBrokerV.Results[0];
     1172  if Piece(RPCResult,'^',1)='0' then begin
     1173    MessageDlg(Piece(RPCResult,'^',2),mtError,[mbOK],0);
     1174  end else begin
     1175    result := Piece(RPCResult,'^',2);
     1176  end;
     1177
     1178  InFile.Free;
     1179  StatusText('');
     1180end;
     1181
     1182
     1183procedure TfrmImages.EnableAutoScanUploadClick(Sender: TObject);
     1184begin
     1185  inherited;
     1186  AutoScanUpload.Checked := not AutoScanUpload.Checked;
     1187  uTMGOptions.WriteBool('Scan Enabled',AutoScanUpload.Checked);
     1188end;
     1189
     1190
     1191procedure TfrmImages.PickScanFolderClick(Sender: TObject);
     1192var
     1193  CurScanDir : string;
     1194begin
     1195  inherited;
     1196  CurScanDir := UploadForm.ScanDir;
     1197  OpenDialog.InitialDir := CurScanDir;
     1198  MessageDlg('Please pick ANY file in the desired directory.',mtInformation,[mbOK],0);
     1199  if OpenDialog.Execute then begin
     1200    UploadForm.SetScanDir(ExtractFilePath(OpenDialog.FileName));
     1201  end;
     1202  AutoScanUpload.Checked := true;
     1203end;
     1204
     1205function TfrmImages.FileSize(fileName : wideString) : Int64;
     1206var
     1207  sr : TSearchRec;
     1208begin
     1209  if FindFirst(fileName, faAnyFile, sr ) = 0 then
     1210     result := Int64(sr.FindData.nFileSizeHigh) shl Int64(32) +  Int64(sr.FindData.nFileSizeLow)
     1211  else
     1212     result := -1;
     1213
     1214  FindClose(sr) ;
     1215end;
     1216
    9181217initialization
    9191218  //put init code here
Note: See TracChangeset for help on using the changeset viewer.