Measure/Units/UpFileManageUnit.pas

{*******************************************************************************
  单元名称：  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, APhase: Integer): TUpFile; overload;

    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;

{ 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
  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, iPhase: 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]);
        iPhase := 0;  // AAAAA
        vFile := Add(iBillID, iPhase);
        vFile.ID := StrToInt(vArrFile[i, 9]);
        vFile.WebID := TProjectData(FProjectData).WebID;
        vFile.Category := vArrFile[i, 5];
        vFile.Memo := vArrFile[i, 6];
        vFile.UperID := StrToInt(vArrFile[i, 7]);
        vFile.UperName := vArrFile[i, 3];
        vFile.UpTime := vArrFile[i, 8];
        vFile.LocalFile := FPath + vArrFile[i, 1];
        vFile.DisplayName := vArrFile[i, 1];
        vFile.DownURL := vArrFile[i, 0];
        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, APhase: Integer): TUpFile;
var vFile: TUpFile;
begin
  vFile := TUpFile.Create;
  vFile.No := Add(vFile);
  vFile.Owner := Self;
  vFile.BillID := ABillID;
  vFile.Phase := APhase;
  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;

end.