{******************************************************************************* 单元名称: UpFileManageUnit.pas 单元说明: 计量支付附件,数据模块。云版和单机版区别很大。 作者时间: Chenshilong, 2015-01-16 *******************************************************************************} unit UpFileManageUnit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, ExtCtrls, StdCtrls, ShellAPI, ADODB; type TUpFileStatus = (ufsNormal, ufsNeedUp, ufsUping, ufsDowning, ufsDownFail); // 控制界面显示:常规、等待上传、上传中、下载中 TStatusChangeEvent = procedure (AStatus: TUpFileStatus) of object; TUpFiles = class; TUpFile = class(TObject) private FUperName: string; FUpTime: string; FWebFile: string; FMemo: string; FStatus: TUpFileStatus; FIcon: TIcon; FBillID: Integer; FID: Integer; FCategory: string; FDisplayName: string; FWebID: Integer; FUperID: Integer; FOwner: TUpFiles; FDownURL: string; FLocalFile: string; FOnStatusChange: TStatusChangeEvent; FOrgFile: string; FPhase: Integer; FNo: Integer; procedure SetWebFile(const Value: string); procedure SetMemo(const Value: string); procedure SetStatus(const Value: TUpFileStatus); procedure SetUperName(const Value: string); procedure SetUpTime(const Value: string); procedure SetBillID(const Value: Integer); procedure SetID(const Value: Integer); procedure SetCategory(const Value: string); procedure SetDisplayName(const Value: string); procedure SetWebID(const Value: Integer); procedure SetUperID(const Value: Integer); procedure SetOwner(const Value: TUpFiles); procedure SetDownURL(const Value: string); procedure SetLocalFile(const Value: string); procedure SetOrgFile(const Value: string); procedure SetPhase(const Value: Integer); procedure SetNo(const Value: Integer); function GetExt: string; public property No: Integer read FNo write SetNo; // 索引号,进入TList的顺序号。 property ID: Integer read FID write SetID; // ID,主键 property WebID: Integer read FWebID write SetWebID; // 服务器端的标段ID property Phase: Integer read FPhase write SetPhase; // 期号 property BillID: Integer read FBillID write SetBillID; // 用于关联清单 property UperID: Integer read FUperID write SetUperID; // 上传者ID property UperName: string read FUperName write SetUperName; // 上传者姓名 property UpTime: string read FUpTime write SetUpTime; // 上传时间 property Category: string read FCategory write SetCategory; // 所属分类:清单附件、台帐附件等 property OrgFile: string read FOrgFile write SetOrgFile; // 原始文件:随意放在硬盘某个角落,即将用来上传或用来本地统一管理的文件。(含路径) property WebFile: string read FWebFile write SetWebFile; // 网络文件:原始文件上传到服务器后,PHP因安全因素重新编码文件名后生成新的文件名,如"20150201.jpg"。(路径+编码文件名) property LocalFile: string read FLocalFile write SetLocalFile; // 本地文件:原始文件被统一管理后(单机版)或网络文件下载到本地后的文件。(完整路径+本地文件文件名) property DisplayName: string read FDisplayName write SetDisplayName; // 本地显示给用户看的文件名。 property DownURL: string read FDownURL write SetDownURL; // 下载链接,用于从服务器下载文件到本地 property Icon: TIcon read FIcon; // 文件系统图标 property Memo: string read FMemo write SetMemo; // 上传者的备注 property Status: TUpFileStatus read FStatus write SetStatus; // 状态信息,用于控制界面的显示 property Ext: string read GetExt; property Owner: TUpFiles read FOwner write SetOwner; property OnStatusChange: TStatusChangeEvent read FOnStatusChange write FOnStatusChange; constructor Create; destructor Destroy; override; end; TUpFiles = class(TObject) private FList: TList; FProjectData: TObject; FPath: string; // -------------业务扩展,单机版本地也要存储管理附件,以下这部分适用于单机版。 // FLocalCon: TADOConnection; // FLocalQue: TADOQuery; // FLocalQue2: TADOQuery; function GetItem(Index: Integer): TUpFile; procedure Clear; function GetCount: Integer; procedure SetProjectData(const Value: TObject); public constructor Create; destructor Destroy; override; function Add(AUpFile: TUpFile): Integer; overload; // 返回索引号 function Add(ABillID: Integer): TUpFile; overload; function Find(AID: Integer): TUpFile; procedure Delete(AIndex: Integer); overload; procedure Delete(AUpFile: TUpFile); overload; procedure Exchange(AUpFile1, AUpFile2: TUpFile); procedure LoadDatas; // function LocalSaveToDB(AUpFile: TUpFile): Integer; // 返回ID property Item[Index: Integer]: TUpFile read GetItem; default; property Count: Integer read GetCount; property ProjectData: TObject read FProjectData write SetProjectData; property Path: string read FPath; end; implementation uses ProjectData, Forms, PHPWebDm, CslJson, ConstUnit, UtilMethods, StdConvs; { TUpFile } constructor TUpFile.Create; begin inherited; FIcon := TIcon.Create; end; destructor TUpFile.Destroy; begin FIcon.Free; inherited; end; procedure TUpFile.SetWebFile(const Value: string); begin FWebFile := Value; end; procedure TUpFile.SetBillID(const Value: Integer); begin FBillID := Value; end; procedure TUpFile.SetMemo(const Value: string); begin FMemo := Value; end; procedure TUpFile.SetStatus(const Value: TUpFileStatus); begin FStatus := Value; if Assigned(FOnStatusChange) then FOnStatusChange(FStatus); end; procedure TUpFile.SetUperName(const Value: string); begin FUperName := Value; end; procedure TUpFile.SetUpTime(const Value: string); begin FUpTime := Value; end; { TUpFileList } function TUpFiles.Add(AUpFile: TUpFile): Integer; begin Result := FList.Add(AUpFile); end; procedure TUpFiles.Clear; var i: Integer; begin for i := 0 to FList.Count - 1 do TUpFile(FList[i]).Free; FList.Clear; end; constructor TUpFiles.Create; begin FList := TList.Create; // if not G_IsCloud then // begin // FLocalCon := TADOConnection.Create(nil); // FLocalCon.LoginPrompt := False; // // FLocalQue := TADOQuery.Create(nil); // FLocalQue.Connection := FLocalCon; // // FLocalQue2 := TADOQuery.Create(nil); // FLocalQue2.Connection := FLocalCon; // end; end; procedure TUpFiles.Delete(AUpFile: TUpFile); begin if AUpFile = nil then Exit; FList.Remove(AUpFile); end; procedure TUpFiles.Delete(AIndex: Integer); begin TUpFile(FList[AIndex]).Free; FList.Delete(AIndex); end; destructor TUpFiles.Destroy; begin Clear; FList.Free; // if not G_IsCloud then // begin // FLocalQue.Close; // FLocalQue.Free; // FLocalQue2.Close; // FLocalQue2.Free; // FLocalCon.Close; // FLocalCon.Free; // end; inherited; end; procedure TUpFiles.Exchange(AUpFile1, AUpFile2: TUpFile); var idx1, idx2: Integer; begin idx1 := FList.IndexOf(AUpFile1); idx2 := FList.IndexOf(AUpFile2); if idx1 < 0 then Exit; if idx2 < 0 then Exit; FList.Exchange(idx1, idx2); end; function TUpFiles.GetCount: Integer; begin Result := FList.Count; end; function TUpFiles.GetItem(Index: Integer): TUpFile; begin Result := TUpFile(FList[Index]); end; procedure TUpFiles.LoadDatas; var vArrFile: TOVArr; i, iBillID: Integer; vFile: TUpFile; begin if G_IsCloud then begin if PHPWeb.GetAttachmentFileList(TProjectData(FProjectData).WebID, vArrFile) then begin for i := Low(vArrFile) to High(vArrFile) do begin iBillID := StrToInt(vArrFile[i, 4]); vFile := Add(iBillID); // AAAAA vFile.DownURL := vArrFile[i, 0]; vFile.DisplayName := vArrFile[i, 1]; vFile.LocalFile := FPath + vArrFile[i, 1]; vFile.Phase := StrToInt(vArrFile[i, 2]); vFile.UperName := vArrFile[i, 3]; vFile.Category := vArrFile[i, 5]; vFile.Memo := vArrFile[i, 6]; vFile.UperID := StrToInt(vArrFile[i, 7]); vFile.UpTime := vArrFile[i, 8]; vFile.ID := StrToInt(vArrFile[i, 9]); vFile.WebID := TProjectData(FProjectData).WebID; vFile.Status := ufsNormal; end; end; end; // else // begin // FLocalQue.Close; // FLocalQue.SQL.Text := 'Select * from AttachmentFile order by ID'; // FLocalQue.Open; // FLocalQue.First; // // while not FLocalQue.Eof do // begin // iBillID := FLocalQue.FieldByName('BillID').AsInteger; // iPhase := FLocalQue.FieldByName('Phase').AsInteger; // vFile := Add(iBillID, iPhase); // vFile.ID := FLocalQue.FieldByName('ID').AsInteger; // vFile.LocalFile := FPath + FLocalQue.FieldByName('FileName').AsString; // vFile.DisplayName := FLocalQue.FieldByName('FileName').AsString; // // FLocalQue.Next; // end; // // FLocalCon.Close; // end; end; procedure TUpFile.SetID(const Value: Integer); begin FID := Value; end; procedure TUpFile.SetCategory(const Value: string); begin FCategory := Value; end; procedure TUpFile.SetDisplayName(const Value: string); begin FDisplayName := Value; end; procedure TUpFile.SetWebID(const Value: Integer); begin FWebID := Value; end; procedure TUpFile.SetUperID(const Value: Integer); begin FUperID := Value; end; procedure TUpFiles.SetProjectData(const Value: TObject); var sLAFM, sModelFile: string; begin FProjectData := Value; if G_IsCloud then begin FPath := PHPWeb.WebPath + 'Projects\' + IntToStr(TProjectData(FProjectData).WebID) + '\Attachment\'; if not DirectoryExists(FPath) then ForceDirectories(FPath); end; // else // begin // FPath := ExtractFilePath(Application.ExeName) + '我的项目\Attachment\' + ExtractFileName(TProjectData(FProjectData).FileName) + '\'; // if not DirectoryExists(FPath) then // ForceDirectories(FPath); // // sLAFM := FPath + 'LocalAttachmentFileManager.dat'; // sModelFile := ExtractFilePath(Application.ExeName) + 'Data\LocalAttachmentFileManager.dat'; // if not FileExists(sLAFM) then // if not CopyFile(PChar(sModelFile), PChar(sLAFM), True) then // begin // Application.MessageBox(PChar('本地附件管理库模板文件“' + sModelFile + '”丢失或被占用无法复制。'), '警告', MB_OK + MB_ICONWARNING); // Exit; // end; // // FLocalCon.ConnectionString := Format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Persist Security Info=False;', [sLAFM]); // end; end; procedure TUpFile.SetOwner(const Value: TUpFiles); begin FOwner := Value; end; procedure TUpFile.SetDownURL(const Value: string); begin FDownURL := Value; end; procedure TUpFile.SetLocalFile(const Value: string); var sExt: string; sInfo: SHFILEINFO; begin FLocalFile := Value; // 系统图标 sExt := ExtractFileExt(FLocalFile); if sExt = '' then Exit; FillChar(sInfo, SizeOf(sInfo), 0); SHGetFileInfo(PChar(sExt), FILE_ATTRIBUTE_NORMAL, sInfo, SizeOf(sInfo), SHGFI_USEFILEATTRIBUTES or SHGFI_ICON or SHGFI_LARGEICON); if sInfo.hIcon > 0 then FIcon.Handle := sInfo.hIcon; end; function TUpFiles.Add(ABillID: Integer): TUpFile; var vFile: TUpFile; begin vFile := TUpFile.Create; vFile.No := Add(vFile); vFile.Owner := Self; vFile.BillID := ABillID; Result := vFile; end; procedure TUpFile.SetOrgFile(const Value: string); begin FOrgFile := Value; end; //function TUpFiles.LocalSaveToDB(AUpFile: TUpFile): Integer; //begin // try // FLocalQue2.Close; // FLocalQue2.SQL.Text := 'Select * from AttachmentFile where 1 < 0'; // FLocalQue2.Open; // FLocalQue2.Append; // FLocalQue2.FieldByName('BillID').AsInteger := AUpFile.BillID; // FLocalQue2.FieldByName('Phase').AsInteger := AUpFile.Phase; // FLocalQue2.FieldByName('FileName').AsString := AUpFile.DisplayName; // FLocalQue2.Post; // Result := FLocalQue2.FieldByName('ID').AsInteger; // FLocalQue2.Close; // except // Result := -1; // Application.MessageBox('本地保存失败,请重试!', '警告', MB_OK + MB_ICONWARNING); // end; //end; procedure TUpFile.SetPhase(const Value: Integer); begin FPhase := Value; end; procedure TUpFile.SetNo(const Value: Integer); begin FNo := Value; end; function TUpFile.GetExt: string; begin Result := ExtractFileExt(DisplayName); end; function TUpFiles.Find(AID: Integer): TUpFile; var i: Integer; vUpFile: TUpFile; begin vUpFile := nil; for i := 0 to FList.Count - 1 do begin vUpFile := TUpFile(FList[i]); if vUpFile.ID = AID then begin Result := vUpFile; Break; end; end; end; end.