UpFileManageUnit.pas 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445
  1. {*******************************************************************************
  2. 单元名称: UpFileManageUnit.pas
  3. 单元说明: 计量支付附件,数据模块。云版和单机版区别很大。
  4. 作者时间: Chenshilong, 2015-01-16
  5. *******************************************************************************}
  6. unit UpFileManageUnit;
  7. interface
  8. uses
  9. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  10. ExtCtrls, StdCtrls, ShellAPI, ADODB;
  11. type
  12. TUpFileStatus = (ufsNormal, ufsNeedUp, ufsUping, ufsDowning, ufsDownFail); // 控制界面显示:常规、等待上传、上传中、下载中
  13. TStatusChangeEvent = procedure (AStatus: TUpFileStatus) of object;
  14. TUpFiles = class;
  15. TUpFile = class(TObject)
  16. private
  17. FUperName: string;
  18. FUpTime: string;
  19. FWebFile: string;
  20. FMemo: string;
  21. FStatus: TUpFileStatus;
  22. FIcon: TIcon;
  23. FBillID: Integer;
  24. FID: Integer;
  25. FCategory: string;
  26. FDisplayName: string;
  27. FWebID: Integer;
  28. FUperID: Integer;
  29. FOwner: TUpFiles;
  30. FDownURL: string;
  31. FLocalFile: string;
  32. FOnStatusChange: TStatusChangeEvent;
  33. FOrgFile: string;
  34. FPhase: Integer;
  35. FNo: Integer;
  36. procedure SetWebFile(const Value: string);
  37. procedure SetMemo(const Value: string);
  38. procedure SetStatus(const Value: TUpFileStatus);
  39. procedure SetUperName(const Value: string);
  40. procedure SetUpTime(const Value: string);
  41. procedure SetBillID(const Value: Integer);
  42. procedure SetID(const Value: Integer);
  43. procedure SetCategory(const Value: string);
  44. procedure SetDisplayName(const Value: string);
  45. procedure SetWebID(const Value: Integer);
  46. procedure SetUperID(const Value: Integer);
  47. procedure SetOwner(const Value: TUpFiles);
  48. procedure SetDownURL(const Value: string);
  49. procedure SetLocalFile(const Value: string);
  50. procedure SetOrgFile(const Value: string);
  51. procedure SetPhase(const Value: Integer);
  52. procedure SetNo(const Value: Integer);
  53. function GetExt: string;
  54. public
  55. property No: Integer read FNo write SetNo; // 索引号,进入TList的顺序号。
  56. property ID: Integer read FID write SetID; // ID,主键
  57. property WebID: Integer read FWebID write SetWebID; // 服务器端的标段ID
  58. property Phase: Integer read FPhase write SetPhase; // 期号
  59. property BillID: Integer read FBillID write SetBillID; // 用于关联清单
  60. property UperID: Integer read FUperID write SetUperID; // 上传者ID
  61. property UperName: string read FUperName write SetUperName; // 上传者姓名
  62. property UpTime: string read FUpTime write SetUpTime; // 上传时间
  63. property Category: string read FCategory write SetCategory; // 所属分类:清单附件、台帐附件等
  64. property OrgFile: string read FOrgFile write SetOrgFile; // 原始文件:随意放在硬盘某个角落,即将用来上传或用来本地统一管理的文件。(含路径)
  65. property WebFile: string read FWebFile write SetWebFile; // 网络文件:原始文件上传到服务器后,PHP因安全因素重新编码文件名后生成新的文件名,如"20150201.jpg"。(路径+编码文件名)
  66. property LocalFile: string read FLocalFile write SetLocalFile; // 本地文件:原始文件被统一管理后(单机版)或网络文件下载到本地后的文件。(完整路径+本地文件文件名)
  67. property DisplayName: string read FDisplayName write SetDisplayName; // 本地显示给用户看的文件名。
  68. property DownURL: string read FDownURL write SetDownURL; // 下载链接,用于从服务器下载文件到本地
  69. property Icon: TIcon read FIcon; // 文件系统图标
  70. property Memo: string read FMemo write SetMemo; // 上传者的备注
  71. property Status: TUpFileStatus read FStatus write SetStatus; // 状态信息,用于控制界面的显示
  72. property Ext: string read GetExt;
  73. property Owner: TUpFiles read FOwner write SetOwner;
  74. property OnStatusChange: TStatusChangeEvent read FOnStatusChange write FOnStatusChange;
  75. constructor Create;
  76. destructor Destroy; override;
  77. end;
  78. TUpFiles = class(TObject)
  79. private
  80. FList: TList;
  81. FProjectData: TObject;
  82. FPath: string;
  83. // -------------业务扩展,单机版本地也要存储管理附件,以下这部分适用于单机版。
  84. FLocalCon: TADOConnection;
  85. FLocalQue: TADOQuery;
  86. FLocalQue2: TADOQuery;
  87. function GetItem(Index: Integer): TUpFile;
  88. procedure Clear;
  89. function GetCount: Integer;
  90. procedure SetProjectData(const Value: TObject);
  91. public
  92. constructor Create;
  93. destructor Destroy; override;
  94. function Add(AUpFile: TUpFile): Integer; overload; // 返回索引号
  95. function Add(ABillID, APhase: Integer): TUpFile; overload;
  96. procedure Delete(AIndex: Integer); overload;
  97. procedure Delete(AUpFile: TUpFile); overload;
  98. procedure Exchange(AUpFile1, AUpFile2: TUpFile);
  99. procedure LoadDatas;
  100. function LocalSaveToDB(AUpFile: TUpFile): Integer; // 返回ID
  101. property Item[Index: Integer]: TUpFile read GetItem; default;
  102. property Count: Integer read GetCount;
  103. property ProjectData: TObject read FProjectData write SetProjectData;
  104. property Path: string read FPath;
  105. end;
  106. implementation
  107. uses ProjectData, Forms, PHPWebDm, CslJson, ConstUnit, UtilMethods;
  108. { TUpFile }
  109. constructor TUpFile.Create;
  110. begin
  111. inherited;
  112. FIcon := TIcon.Create;
  113. end;
  114. destructor TUpFile.Destroy;
  115. begin
  116. FIcon.Free;
  117. inherited;
  118. end;
  119. procedure TUpFile.SetWebFile(const Value: string);
  120. begin
  121. FWebFile := Value;
  122. end;
  123. procedure TUpFile.SetBillID(const Value: Integer);
  124. begin
  125. FBillID := Value;
  126. end;
  127. procedure TUpFile.SetMemo(const Value: string);
  128. begin
  129. FMemo := Value;
  130. end;
  131. procedure TUpFile.SetStatus(const Value: TUpFileStatus);
  132. begin
  133. FStatus := Value;
  134. if Assigned(FOnStatusChange) then
  135. FOnStatusChange(FStatus);
  136. end;
  137. procedure TUpFile.SetUperName(const Value: string);
  138. begin
  139. FUperName := Value;
  140. end;
  141. procedure TUpFile.SetUpTime(const Value: string);
  142. begin
  143. FUpTime := Value;
  144. end;
  145. { TUpFileList }
  146. function TUpFiles.Add(AUpFile: TUpFile): Integer;
  147. begin
  148. Result := FList.Add(AUpFile);
  149. end;
  150. procedure TUpFiles.Clear;
  151. var
  152. i: Integer;
  153. begin
  154. for i := 0 to FList.Count - 1 do
  155. TUpFile(FList[i]).Free;
  156. FList.Clear;
  157. end;
  158. constructor TUpFiles.Create;
  159. begin
  160. FList := TList.Create;
  161. if not G_IsCloud then
  162. begin
  163. FLocalCon := TADOConnection.Create(nil);
  164. FLocalCon.LoginPrompt := False;
  165. FLocalQue := TADOQuery.Create(nil);
  166. FLocalQue.Connection := FLocalCon;
  167. FLocalQue2 := TADOQuery.Create(nil);
  168. FLocalQue2.Connection := FLocalCon;
  169. end;
  170. end;
  171. procedure TUpFiles.Delete(AUpFile: TUpFile);
  172. begin
  173. FList.Remove(AUpFile);
  174. end;
  175. procedure TUpFiles.Delete(AIndex: Integer);
  176. begin
  177. TUpFile(FList[AIndex]).Free;
  178. FList.Delete(AIndex);
  179. end;
  180. destructor TUpFiles.Destroy;
  181. begin
  182. Clear;
  183. FList.Free;
  184. if not G_IsCloud then
  185. begin
  186. FLocalQue.Close;
  187. FLocalQue.Free;
  188. FLocalQue2.Close;
  189. FLocalQue2.Free;
  190. FLocalCon.Close;
  191. FLocalCon.Free;
  192. end;
  193. inherited;
  194. end;
  195. procedure TUpFiles.Exchange(AUpFile1, AUpFile2: TUpFile);
  196. var
  197. idx1, idx2: Integer;
  198. begin
  199. idx1 := FList.IndexOf(AUpFile1);
  200. idx2 := FList.IndexOf(AUpFile2);
  201. if idx1 < 0 then Exit;
  202. if idx2 < 0 then Exit;
  203. FList.Exchange(idx1, idx2);
  204. end;
  205. function TUpFiles.GetCount: Integer;
  206. begin
  207. Result := FList.Count;
  208. end;
  209. function TUpFiles.GetItem(Index: Integer): TUpFile;
  210. begin
  211. Result := TUpFile(FList[Index]);
  212. end;
  213. procedure TUpFiles.LoadDatas;
  214. var vArrFile: TOVArr;
  215. i, iBillID, iPhase: Integer;
  216. vFile: TUpFile;
  217. begin
  218. if G_IsCloud then
  219. begin
  220. if PHPWeb.GetAttachmentFileList(TProjectData(FProjectData).WebID, vArrFile) then
  221. begin
  222. for i := Low(vArrFile) to High(vArrFile) do
  223. begin
  224. iBillID := StrToInt(vArrFile[i, 4]);
  225. iPhase := 0; // AAAAA
  226. vFile := Add(iBillID, iPhase);
  227. vFile.ID := StrToInt(vArrFile[i, 9]);
  228. vFile.WebID := TProjectData(FProjectData).WebID;
  229. vFile.Category := vArrFile[i, 5];
  230. vFile.Memo := vArrFile[i, 6];
  231. vFile.UperID := StrToInt(vArrFile[i, 7]);
  232. vFile.UperName := vArrFile[i, 3];
  233. vFile.UpTime := vArrFile[i, 8];
  234. vFile.LocalFile := FPath + vArrFile[i, 1];
  235. vFile.DisplayName := vArrFile[i, 1];
  236. vFile.DownURL := vArrFile[i, 0];
  237. vFile.Status := ufsNormal;
  238. end;
  239. end;
  240. end
  241. else
  242. begin
  243. FLocalQue.Close;
  244. FLocalQue.SQL.Text := 'Select * from AttachmentFile order by ID';
  245. FLocalQue.Open;
  246. FLocalQue.First;
  247. while not FLocalQue.Eof do
  248. begin
  249. iBillID := FLocalQue.FieldByName('BillID').AsInteger;
  250. iPhase := FLocalQue.FieldByName('Phase').AsInteger;
  251. vFile := Add(iBillID, iPhase);
  252. vFile.ID := FLocalQue.FieldByName('ID').AsInteger;
  253. vFile.LocalFile := FPath + FLocalQue.FieldByName('FileName').AsString;
  254. vFile.DisplayName := FLocalQue.FieldByName('FileName').AsString;
  255. FLocalQue.Next;
  256. end;
  257. FLocalCon.Close;
  258. end;
  259. end;
  260. procedure TUpFile.SetID(const Value: Integer);
  261. begin
  262. FID := Value;
  263. end;
  264. procedure TUpFile.SetCategory(const Value: string);
  265. begin
  266. FCategory := Value;
  267. end;
  268. procedure TUpFile.SetDisplayName(const Value: string);
  269. begin
  270. FDisplayName := Value;
  271. end;
  272. procedure TUpFile.SetWebID(const Value: Integer);
  273. begin
  274. FWebID := Value;
  275. end;
  276. procedure TUpFile.SetUperID(const Value: Integer);
  277. begin
  278. FUperID := Value;
  279. end;
  280. procedure TUpFiles.SetProjectData(const Value: TObject);
  281. var sLAFM, sModelFile: string;
  282. begin
  283. FProjectData := Value;
  284. if G_IsCloud then
  285. begin
  286. FPath := PHPWeb.WebPath + 'Projects\' + IntToStr(TProjectData(FProjectData).WebID) + '\Attachment\';
  287. if not DirectoryExists(FPath) then
  288. ForceDirectories(FPath);
  289. end
  290. else
  291. begin
  292. FPath := ExtractFilePath(Application.ExeName) + '我的项目\Attachment\' + ExtractFileName(TProjectData(FProjectData).FileName) + '\';
  293. if not DirectoryExists(FPath) then
  294. ForceDirectories(FPath);
  295. sLAFM := FPath + 'LocalAttachmentFileManager.dat';
  296. sModelFile := ExtractFilePath(Application.ExeName) + 'Data\LocalAttachmentFileManager.dat';
  297. if not FileExists(sLAFM) then
  298. if not CopyFile(PChar(sModelFile), PChar(sLAFM), True) then
  299. begin
  300. Application.MessageBox(PChar('本地附件管理库模板文件“' + sModelFile + '”丢失或被占用无法复制。'), '警告', MB_OK + MB_ICONWARNING);
  301. Exit;
  302. end;
  303. FLocalCon.ConnectionString := Format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Persist Security Info=False;', [sLAFM]);
  304. end;
  305. end;
  306. procedure TUpFile.SetOwner(const Value: TUpFiles);
  307. begin
  308. FOwner := Value;
  309. end;
  310. procedure TUpFile.SetDownURL(const Value: string);
  311. begin
  312. FDownURL := Value;
  313. end;
  314. procedure TUpFile.SetLocalFile(const Value: string);
  315. var
  316. sExt: string;
  317. sInfo: SHFILEINFO;
  318. begin
  319. FLocalFile := Value;
  320. // 系统图标
  321. sExt := ExtractFileExt(FLocalFile);
  322. if sExt = '' then Exit;
  323. FillChar(sInfo, SizeOf(sInfo), 0);
  324. SHGetFileInfo(PChar(sExt), FILE_ATTRIBUTE_NORMAL, sInfo, SizeOf(sInfo),
  325. SHGFI_USEFILEATTRIBUTES or SHGFI_ICON or SHGFI_LARGEICON);
  326. if sInfo.hIcon > 0 then
  327. FIcon.Handle := sInfo.hIcon;
  328. end;
  329. function TUpFiles.Add(ABillID, APhase: Integer): TUpFile;
  330. var vFile: TUpFile;
  331. begin
  332. vFile := TUpFile.Create;
  333. vFile.No := Add(vFile);
  334. vFile.Owner := Self;
  335. vFile.BillID := ABillID;
  336. vFile.Phase := APhase;
  337. Result := vFile;
  338. end;
  339. procedure TUpFile.SetOrgFile(const Value: string);
  340. begin
  341. FOrgFile := Value;
  342. end;
  343. function TUpFiles.LocalSaveToDB(AUpFile: TUpFile): Integer;
  344. begin
  345. try
  346. FLocalQue2.Close;
  347. FLocalQue2.SQL.Text := 'Select * from AttachmentFile where 1 < 0';
  348. FLocalQue2.Open;
  349. FLocalQue2.Append;
  350. FLocalQue2.FieldByName('BillID').AsInteger := AUpFile.BillID;
  351. FLocalQue2.FieldByName('Phase').AsInteger := AUpFile.Phase;
  352. FLocalQue2.FieldByName('FileName').AsString := AUpFile.DisplayName;
  353. FLocalQue2.Post;
  354. Result := FLocalQue2.FieldByName('ID').AsInteger;
  355. FLocalQue2.Close;
  356. except
  357. Result := -1;
  358. Application.MessageBox('本地保存失败,请重试!', '警告', MB_OK + MB_ICONWARNING);
  359. end;
  360. end;
  361. procedure TUpFile.SetPhase(const Value: Integer);
  362. begin
  363. FPhase := Value;
  364. end;
  365. procedure TUpFile.SetNo(const Value: Integer);
  366. begin
  367. FNo := Value;
  368. end;
  369. function TUpFile.GetExt: string;
  370. begin
  371. Result := ExtractFileExt(DisplayName);
  372. end;
  373. end.