UpFileManageUnit.pas 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464
  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: Integer): TUpFile; overload;
  96. function Find(AID: Integer): TUpFile;
  97. procedure Delete(AIndex: Integer); overload;
  98. procedure Delete(AUpFile: TUpFile); overload;
  99. procedure Exchange(AUpFile1, AUpFile2: TUpFile);
  100. procedure LoadDatas;
  101. // function LocalSaveToDB(AUpFile: TUpFile): Integer; // 返回ID
  102. property Item[Index: Integer]: TUpFile read GetItem; default;
  103. property Count: Integer read GetCount;
  104. property ProjectData: TObject read FProjectData write SetProjectData;
  105. property Path: string read FPath;
  106. property List: TList read FList;
  107. end;
  108. implementation
  109. uses ProjectData, Forms, PHPWebDm, CslJson, ConstUnit, UtilMethods,
  110. StdConvs;
  111. { TUpFile }
  112. constructor TUpFile.Create;
  113. begin
  114. inherited;
  115. FIcon := TIcon.Create;
  116. end;
  117. destructor TUpFile.Destroy;
  118. begin
  119. FIcon.Free;
  120. inherited;
  121. end;
  122. procedure TUpFile.SetWebFile(const Value: string);
  123. begin
  124. FWebFile := Value;
  125. end;
  126. procedure TUpFile.SetBillID(const Value: Integer);
  127. begin
  128. FBillID := Value;
  129. end;
  130. procedure TUpFile.SetMemo(const Value: string);
  131. begin
  132. FMemo := Value;
  133. end;
  134. procedure TUpFile.SetStatus(const Value: TUpFileStatus);
  135. begin
  136. FStatus := Value;
  137. if Assigned(FOnStatusChange) then
  138. FOnStatusChange(FStatus);
  139. end;
  140. procedure TUpFile.SetUperName(const Value: string);
  141. begin
  142. FUperName := Value;
  143. end;
  144. procedure TUpFile.SetUpTime(const Value: string);
  145. begin
  146. FUpTime := Value;
  147. end;
  148. { TUpFileList }
  149. function TUpFiles.Add(AUpFile: TUpFile): Integer;
  150. begin
  151. Result := FList.Add(AUpFile);
  152. end;
  153. procedure TUpFiles.Clear;
  154. var
  155. i: Integer;
  156. begin
  157. for i := 0 to FList.Count - 1 do
  158. TUpFile(FList[i]).Free;
  159. FList.Clear;
  160. end;
  161. constructor TUpFiles.Create;
  162. begin
  163. FList := TList.Create;
  164. // if not G_IsCloud then
  165. // begin
  166. // FLocalCon := TADOConnection.Create(nil);
  167. // FLocalCon.LoginPrompt := False;
  168. //
  169. // FLocalQue := TADOQuery.Create(nil);
  170. // FLocalQue.Connection := FLocalCon;
  171. //
  172. // FLocalQue2 := TADOQuery.Create(nil);
  173. // FLocalQue2.Connection := FLocalCon;
  174. // end;
  175. end;
  176. procedure TUpFiles.Delete(AUpFile: TUpFile);
  177. begin
  178. if AUpFile = nil then Exit;
  179. FList.Remove(AUpFile);
  180. end;
  181. procedure TUpFiles.Delete(AIndex: Integer);
  182. begin
  183. TUpFile(FList[AIndex]).Free;
  184. FList.Delete(AIndex);
  185. end;
  186. destructor TUpFiles.Destroy;
  187. begin
  188. Clear;
  189. FList.Free;
  190. // if not G_IsCloud then
  191. // begin
  192. // FLocalQue.Close;
  193. // FLocalQue.Free;
  194. // FLocalQue2.Close;
  195. // FLocalQue2.Free;
  196. // FLocalCon.Close;
  197. // FLocalCon.Free;
  198. // end;
  199. inherited;
  200. end;
  201. procedure TUpFiles.Exchange(AUpFile1, AUpFile2: TUpFile);
  202. var
  203. idx1, idx2: Integer;
  204. begin
  205. idx1 := FList.IndexOf(AUpFile1);
  206. idx2 := FList.IndexOf(AUpFile2);
  207. if idx1 < 0 then Exit;
  208. if idx2 < 0 then Exit;
  209. FList.Exchange(idx1, idx2);
  210. end;
  211. function TUpFiles.GetCount: Integer;
  212. begin
  213. Result := FList.Count;
  214. end;
  215. function TUpFiles.GetItem(Index: Integer): TUpFile;
  216. begin
  217. Result := TUpFile(FList[Index]);
  218. end;
  219. procedure TUpFiles.LoadDatas;
  220. var vArrFile: TOVArr;
  221. i, iBillID: Integer;
  222. vFile: TUpFile;
  223. begin
  224. if G_IsCloud then
  225. begin
  226. if PHPWeb.GetAttachmentList(TProjectData(FProjectData).WebID, vArrFile) then
  227. begin
  228. for i := Low(vArrFile) to High(vArrFile) do
  229. begin
  230. iBillID := StrToInt(vArrFile[i, 4]);
  231. vFile := Add(iBillID); // AAAAA
  232. vFile.DownURL := vArrFile[i, 0];
  233. vFile.DisplayName := vArrFile[i, 1];
  234. vFile.LocalFile := FPath + vArrFile[i, 1];
  235. vFile.UperName := vArrFile[i, 3];
  236. vFile.Category := vArrFile[i, 5];
  237. vFile.Memo := vArrFile[i, 6];
  238. vFile.UperID := StrToInt(vArrFile[i, 7]);
  239. vFile.UpTime := vArrFile[i, 8];
  240. vFile.ID := StrToInt(vArrFile[i, 9]);
  241. vFile.Phase := StrToInt(vArrFile[i, 10]); // vArrFile[i, 2] 文件扩展名
  242. vFile.WebID := TProjectData(FProjectData).WebID;
  243. vFile.Status := ufsNormal;
  244. end;
  245. end;
  246. end;
  247. // else
  248. // begin
  249. // FLocalQue.Close;
  250. // FLocalQue.SQL.Text := 'Select * from AttachmentFile order by ID';
  251. // FLocalQue.Open;
  252. // FLocalQue.First;
  253. //
  254. // while not FLocalQue.Eof do
  255. // begin
  256. // iBillID := FLocalQue.FieldByName('BillID').AsInteger;
  257. // iPhase := FLocalQue.FieldByName('Phase').AsInteger;
  258. // vFile := Add(iBillID, iPhase);
  259. // vFile.ID := FLocalQue.FieldByName('ID').AsInteger;
  260. // vFile.LocalFile := FPath + FLocalQue.FieldByName('FileName').AsString;
  261. // vFile.DisplayName := FLocalQue.FieldByName('FileName').AsString;
  262. //
  263. // FLocalQue.Next;
  264. // end;
  265. //
  266. // FLocalCon.Close;
  267. // end;
  268. end;
  269. procedure TUpFile.SetID(const Value: Integer);
  270. begin
  271. FID := Value;
  272. end;
  273. procedure TUpFile.SetCategory(const Value: string);
  274. begin
  275. FCategory := Value;
  276. end;
  277. procedure TUpFile.SetDisplayName(const Value: string);
  278. begin
  279. FDisplayName := Value;
  280. end;
  281. procedure TUpFile.SetWebID(const Value: Integer);
  282. begin
  283. FWebID := Value;
  284. end;
  285. procedure TUpFile.SetUperID(const Value: Integer);
  286. begin
  287. FUperID := Value;
  288. end;
  289. procedure TUpFiles.SetProjectData(const Value: TObject);
  290. var sLAFM, sModelFile: string;
  291. begin
  292. FProjectData := Value;
  293. if G_IsCloud then
  294. begin
  295. FPath := PHPWeb.WebPath + 'Projects\' + IntToStr(TProjectData(FProjectData).WebID) + '\Attachment\';
  296. if not DirectoryExists(FPath) then
  297. ForceDirectories(FPath);
  298. end;
  299. // else
  300. // begin
  301. // FPath := ExtractFilePath(Application.ExeName) + '我的项目\Attachment\' + ExtractFileName(TProjectData(FProjectData).FileName) + '\';
  302. // if not DirectoryExists(FPath) then
  303. // ForceDirectories(FPath);
  304. //
  305. // sLAFM := FPath + 'LocalAttachmentFileManager.dat';
  306. // sModelFile := ExtractFilePath(Application.ExeName) + 'Data\LocalAttachmentFileManager.dat';
  307. // if not FileExists(sLAFM) then
  308. // if not CopyFile(PChar(sModelFile), PChar(sLAFM), True) then
  309. // begin
  310. // Application.MessageBox(PChar('本地附件管理库模板文件“' + sModelFile + '”丢失或被占用无法复制。'), '警告', MB_OK + MB_ICONWARNING);
  311. // Exit;
  312. // end;
  313. //
  314. // FLocalCon.ConnectionString := Format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Persist Security Info=False;', [sLAFM]);
  315. // end;
  316. end;
  317. procedure TUpFile.SetOwner(const Value: TUpFiles);
  318. begin
  319. FOwner := Value;
  320. end;
  321. procedure TUpFile.SetDownURL(const Value: string);
  322. begin
  323. FDownURL := Value;
  324. end;
  325. procedure TUpFile.SetLocalFile(const Value: string);
  326. var
  327. sExt: string;
  328. sInfo: SHFILEINFO;
  329. begin
  330. FLocalFile := Value;
  331. // 系统图标
  332. sExt := ExtractFileExt(FLocalFile);
  333. if sExt = '' then Exit;
  334. FillChar(sInfo, SizeOf(sInfo), 0);
  335. SHGetFileInfo(PChar(sExt), FILE_ATTRIBUTE_NORMAL, sInfo, SizeOf(sInfo),
  336. SHGFI_USEFILEATTRIBUTES or SHGFI_ICON or SHGFI_LARGEICON);
  337. if sInfo.hIcon > 0 then
  338. FIcon.Handle := sInfo.hIcon;
  339. end;
  340. function TUpFiles.Add(ABillID: Integer): TUpFile;
  341. var vFile: TUpFile;
  342. begin
  343. vFile := TUpFile.Create;
  344. vFile.No := Add(vFile);
  345. vFile.Owner := Self;
  346. vFile.BillID := ABillID;
  347. Result := vFile;
  348. end;
  349. procedure TUpFile.SetOrgFile(const Value: string);
  350. begin
  351. FOrgFile := Value;
  352. end;
  353. //function TUpFiles.LocalSaveToDB(AUpFile: TUpFile): Integer;
  354. //begin
  355. // try
  356. // FLocalQue2.Close;
  357. // FLocalQue2.SQL.Text := 'Select * from AttachmentFile where 1 < 0';
  358. // FLocalQue2.Open;
  359. // FLocalQue2.Append;
  360. // FLocalQue2.FieldByName('BillID').AsInteger := AUpFile.BillID;
  361. // FLocalQue2.FieldByName('Phase').AsInteger := AUpFile.Phase;
  362. // FLocalQue2.FieldByName('FileName').AsString := AUpFile.DisplayName;
  363. // FLocalQue2.Post;
  364. // Result := FLocalQue2.FieldByName('ID').AsInteger;
  365. // FLocalQue2.Close;
  366. // except
  367. // Result := -1;
  368. // Application.MessageBox('本地保存失败,请重试!', '警告', MB_OK + MB_ICONWARNING);
  369. // end;
  370. //end;
  371. procedure TUpFile.SetPhase(const Value: Integer);
  372. begin
  373. FPhase := Value;
  374. end;
  375. procedure TUpFile.SetNo(const Value: Integer);
  376. begin
  377. FNo := Value;
  378. end;
  379. function TUpFile.GetExt: string;
  380. begin
  381. Result := ExtractFileExt(DisplayName);
  382. end;
  383. function TUpFiles.Find(AID: Integer): TUpFile;
  384. var i: Integer;
  385. vUpFile: TUpFile;
  386. begin
  387. vUpFile := nil;
  388. for i := 0 to FList.Count - 1 do
  389. begin
  390. vUpFile := TUpFile(FList[i]);
  391. if vUpFile.ID = AID then
  392. begin
  393. Result := vUpFile;
  394. Break;
  395. end;
  396. end;
  397. end;
  398. end.