UpFileManageFrame.pas 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491
  1. {*******************************************************************************
  2. 单元名称: UpFileManageFrame.pas
  3. 单元说明: 计量支付附件,UI界面。
  4. 作者时间: Chenshilong, 2015-01-13
  5. *******************************************************************************}
  6. unit UpFileManageFrame;
  7. interface
  8. uses
  9. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  10. Dialogs, StdCtrls, ExtCtrls, PNGButton, UpFileFrame, UpFileManageUnit, sdDB,
  11. Menus, Buttons;
  12. type
  13. TUpFileManageView = class(TFrame)
  14. pnlHead: TPanel;
  15. lblBillName: TLabel;
  16. btnSelectUpFile: TPNGButton;
  17. Shape5: TShape;
  18. Label6: TLabel;
  19. Label7: TLabel;
  20. Shape6: TShape;
  21. pnlDetail: TPanel;
  22. btnEditNo: TPNGButton;
  23. btnEdit: TPNGButton;
  24. lblCaption: TLabel;
  25. Shape1: TShape;
  26. Shape2: TShape;
  27. Shape3: TShape;
  28. btnDown: TPNGButton;
  29. Shape4: TShape;
  30. Label1: TLabel;
  31. Label2: TLabel;
  32. lblUper: TLabel;
  33. lblUpTime: TLabel;
  34. Label3: TLabel;
  35. lblExt: TLabel;
  36. Label5: TLabel;
  37. lblCategory: TLabel;
  38. Label4: TLabel;
  39. btnEditYes: TPNGButton;
  40. mmMemo: TMemo;
  41. edtFileName: TEdit;
  42. sbFile: TScrollBox;
  43. tDelView: TTimer;
  44. pmUp: TPopupMenu;
  45. miLocalUp: TMenuItem;
  46. miServerUp: TMenuItem;
  47. procedure btnEditClick(Sender: TObject);
  48. procedure btnEditYesClick(Sender: TObject);
  49. procedure btnEditNoClick(Sender: TObject);
  50. procedure btnSelectUpFileClick(Sender: TObject);
  51. procedure tDelViewTimer(Sender: TObject);
  52. procedure btnDownClick(Sender: TObject);
  53. procedure miLocalUpClick(Sender: TObject);
  54. private
  55. FDetailIsEdit: Boolean;
  56. FSelected: TUpFileView;
  57. FDatas: TUpFiles;
  58. FWaitForDelete: TUpFileView;
  59. FDeleteAttachmentOnLine: Boolean;
  60. FOwner: TObject;
  61. FProjectData: TObject;
  62. FRec: TsdDataRecord;
  63. procedure SetSelected(const Value: TUpFileView);
  64. procedure SetDetailIsEdit(const Value: Boolean);
  65. procedure SetDatas(const Value: TUpFiles);
  66. procedure RefreshOtherFileFrames;
  67. procedure RefreshDetail;
  68. procedure RefreshBill;
  69. procedure ClearViews;
  70. procedure ClearDetail;
  71. procedure RefreshViews;
  72. procedure DetailOutEditStatus;
  73. procedure DetailIntoEditStatus;
  74. procedure AddUpFileView(AUpFile: TUpFile);
  75. procedure SetWaitForDelete(const Value: TUpFileView);
  76. procedure SetOwner(const Value: TObject);
  77. procedure SetProjectData(const Value: TObject);
  78. procedure SetRec(const Value: TsdDataRecord);
  79. procedure SelectUpFile;
  80. public
  81. constructor Create(AOwner: TComponent); override;
  82. procedure DeleteViewAndData(AView: TUpFileView; ANeedDeleteOnLine: Boolean);
  83. procedure DoOnBillChange(ARec: TsdDataRecord);
  84. property ProjectData: TObject read FProjectData write SetProjectData;
  85. property Owner: TObject read FOwner write SetOwner;
  86. property Selected: TUpFileView read FSelected write SetSelected;
  87. property DetailIsEdit: Boolean read FDetailIsEdit write SetDetailIsEdit; // 明细部分处理编辑状态
  88. property Datas: TUpFiles read FDatas write SetDatas;
  89. property WaitForDelete: TUpFileView read FWaitForDelete write SetWaitForDelete;
  90. property Rec: TsdDataRecord read FRec write SetRec;
  91. end;
  92. implementation
  93. uses PHPWebDm, ProjectData, IdGlobal, ProjectFme, ConstUnit, MainFrm,
  94. BillsMeasureDm, UtilMethods;
  95. {$R *.dfm}
  96. { TUpFileManageView }
  97. procedure TUpFileManageView.ClearDetail;
  98. begin
  99. edtFileName.Text := '';
  100. lblExt.Caption := '';
  101. lblUper.Caption := '';
  102. lblUpTime.Caption := '';
  103. lblCategory.Caption := '';
  104. mmMemo.Clear;
  105. end;
  106. procedure TUpFileManageView.DetailIntoEditStatus;
  107. begin
  108. edtFileName.BorderStyle := bsSingle;
  109. edtFileName.ReadOnly := False;
  110. mmMemo.BorderStyle := bsSingle;
  111. mmMemo.ReadOnly := False;
  112. btnEdit.Visible := False;
  113. btnEditYes.Visible := True;
  114. btnEditNo.Visible := True;
  115. end;
  116. procedure TUpFileManageView.DetailOutEditStatus;
  117. begin
  118. edtFileName.BorderStyle := bsNone;
  119. edtFileName.ReadOnly := True;
  120. mmMemo.BorderStyle := bsNone;
  121. mmMemo.ReadOnly := True;
  122. btnEdit.Visible := True;
  123. btnEditYes.Visible := False;
  124. btnEditNo.Visible := False;
  125. end;
  126. procedure TUpFileManageView.ClearViews;
  127. var i: Integer;
  128. begin
  129. for i := sbFile.ControlCount - 1 downto 0 do
  130. TUpFileView(sbFile.Controls[i]).Free;
  131. end;
  132. procedure TUpFileManageView.RefreshViews;
  133. var i: Integer;
  134. begin
  135. ClearViews;
  136. ClearDetail;
  137. {'HasAttachment'是不可靠的。一但它不可靠,会导致:有附件却不显示,用户会以为
  138. 附件丢失。不可靠表现为:
  139. ①用户上传成功,本地标记修改完成,之后却因死机或程序出错导致项目没有保存成功,
  140. 这样本地标记没有保存,线上线下不一致。
  141. ②当前用户非工作状态,上传了附件。却因下次从服务器更新覆盖了本地项目,标记丢失。}
  142. if (FRec <> nil) {and (FRec.ValueByName('HasAttachment').AsBoolean = True)} then
  143. for i := 0 to Datas.Count - 1 do
  144. begin
  145. if (Datas[i].BillID = FRec.ValueByName('ID').AsInteger) and (Datas[i].Phase = TProjectData(FProjectData).PhaseIndex) then
  146. AddUpFileView(Datas[i]);
  147. end;
  148. end;
  149. procedure TUpFileManageView.RefreshDetail;
  150. var vFile: TUpFile;
  151. begin
  152. if DetailIsEdit then
  153. DetailOutEditStatus;
  154. vFile := Selected.Data;
  155. if vFile.Status <> ufsNormal then
  156. ClearDetail
  157. else
  158. begin
  159. edtFileName.Text := ExtractFileNameWithoutExt(vFile.DisplayName);
  160. lblExt.Caption := ExtractFileExt(vFile.LocalFile);
  161. lblUper.Caption := vFile.UperName;
  162. lblUpTime.Caption := vFile.UpTime;
  163. lblCategory.Caption := vFile.Category;
  164. mmMemo.Text := vFile.Memo;
  165. end;
  166. btnEdit.Enabled := (edtFileName.Text <> '') and TProjectData(FProjectData).CurUserIsAuthor;
  167. end;
  168. procedure TUpFileManageView.RefreshOtherFileFrames;
  169. var i: Integer;
  170. begin
  171. for i := 0 to sbFile.ControlCount - 1 do
  172. begin
  173. if TUpFileView(sbFile.Controls[i]) <> Selected then
  174. TUpFileView(sbFile.Controls[i]).ShowNormal;
  175. end;
  176. end;
  177. procedure TUpFileManageView.SetSelected(const Value: TUpFileView);
  178. begin
  179. FSelected := Value;
  180. RefreshOtherFileFrames;
  181. if G_IsCloud then
  182. RefreshDetail;
  183. end;
  184. procedure TUpFileManageView.SetDetailIsEdit(const Value: Boolean);
  185. begin
  186. FDetailIsEdit := Value;
  187. end;
  188. procedure TUpFileManageView.btnEditClick(Sender: TObject);
  189. begin
  190. DetailIntoEditStatus;
  191. DetailIsEdit := True;
  192. end;
  193. procedure TUpFileManageView.btnEditYesClick(Sender: TObject);
  194. var sURL, sExt, sNewName, sNewMemo, sNewFile: string;
  195. vArr: array of string;
  196. begin
  197. sExt := Selected.Data.Ext;
  198. sNewName := Trim(edtFileName.Text);
  199. if HasExt(sNewName) then
  200. sNewName := ExtractFileNameWithoutExt(sNewName);
  201. sNewFile := ExtractFilePath(Selected.Data.LocalFile) + sNewName + sExt;
  202. // 以下这个不能判断:如果我只改了备注,没有改文件名,会提交不上。
  203. // if FileExists(sNewFile) then
  204. // begin
  205. // Application.MessageBox('本地已存在同名文件,请更换其它名称!', '编辑失败', MB_OK + MB_ICONWARNING);
  206. // Exit;
  207. // end;
  208. sURL := Format('%stender/attachment/info/%d/update', [PHPWeb.MeasureURL, Selected.Data.ID]);
  209. sNewMemo := mmMemo.Text;
  210. vArr := VarArrayOf(['msg']);
  211. if PHPWeb.Search(sURL, ['FileName', 'Memo'], [sNewName, sNewMemo], vArr) = 1 then
  212. begin
  213. if FileExists(Selected.Data.LocalFile) then
  214. if not RenameFile(Selected.Data.LocalFile, sNewFile) then
  215. begin
  216. Application.MessageBox('本地文件被占用,更换文件名失败,请关闭占用文件后重试!', '编辑失败', MB_OK + MB_ICONWARNING);
  217. Exit;
  218. end;
  219. Selected.Data.LocalFile := sNewFile;
  220. Selected.Data.DisplayName := sNewName + sExt;
  221. Selected.Data.Memo := sNewMemo;
  222. Selected.Refresh;
  223. edtFileName.Text := sNewName;
  224. DetailOutEditStatus;
  225. DetailIsEdit := False;
  226. end
  227. else
  228. begin
  229. Application.MessageBox('因网络原因导致编辑失败,请重试!', '编辑失败', MB_OK + MB_ICONWARNING);
  230. Exit;
  231. end;
  232. end;
  233. procedure TUpFileManageView.btnEditNoClick(Sender: TObject);
  234. begin
  235. DetailOutEditStatus;
  236. DetailIsEdit := False;
  237. edtFileName.Text := Selected.Data.DisplayName;
  238. mmMemo.Text := Selected.Data.Memo;
  239. end;
  240. procedure TUpFileManageView.btnSelectUpFileClick(Sender: TObject);
  241. var
  242. P: TPoint;
  243. begin
  244. GetCursorPos(P);
  245. pmUp.Popup(P.X, P.Y);
  246. end;
  247. procedure TUpFileManageView.SetDatas(const Value: TUpFiles);
  248. begin
  249. FDatas := Value;
  250. end;
  251. procedure TUpFileManageView.AddUpFileView(AUpFile: TUpFile);
  252. var vVew: TUpFileView;
  253. begin
  254. vVew := TUpFileView.Create(Self);
  255. vVew.Name := Format('UpFileView%d', [AUpFile.No]); // 此时ID尚末获取,不能用ID
  256. vVew.Owner := Self;
  257. vVew.ProjectData := FProjectData;
  258. vVew.parent := sbFile;
  259. vVew.Align := alTop;
  260. vVew.Data := AUpFile;
  261. end;
  262. procedure TUpFileManageView.DeleteViewAndData(AView: TUpFileView; ANeedDeleteOnLine: Boolean);
  263. begin
  264. WaitForDelete := AView;
  265. FDeleteAttachmentOnLine := ANeedDeleteOnLine;
  266. tDelView.Enabled := True;
  267. end;
  268. procedure TUpFileManageView.tDelViewTimer(Sender: TObject);
  269. var vUpFile: TUpFile;
  270. begin
  271. tDelView.Enabled := False;
  272. vUpFile := WaitForDelete.Data;
  273. if FDeleteAttachmentOnLine then
  274. if PHPWeb.DeleteAttachment(vUpFile.ID) <> 1 then
  275. Exit;
  276. WaitForDelete.Free;
  277. Datas.Delete(vUpFile);
  278. end;
  279. procedure TUpFileManageView.SetWaitForDelete(const Value: TUpFileView);
  280. begin
  281. FWaitForDelete := Value;
  282. end;
  283. procedure TUpFileManageView.SetOwner(const Value: TObject);
  284. begin
  285. FOwner := Value;
  286. TProjectFrame(FOwner).BillsMeasureFrame.BillsMeasureData.OnRecChange := DoOnBillChange;
  287. TProjectFrame(FOwner).BillsCompileFrame.BillsCompileData.OnRecChange := DoOnBillChange;
  288. end;
  289. procedure TUpFileManageView.SetProjectData(const Value: TObject);
  290. begin
  291. FProjectData := Value;
  292. end;
  293. procedure TUpFileManageView.btnDownClick(Sender: TObject);
  294. var svDlg: TSaveDialog;
  295. sFile: string;
  296. begin
  297. if not Assigned(Selected) then Exit;
  298. svDlg := TSaveDialog.Create(nil);
  299. svDlg.InitialDir := ExtractFilePath(Application.ExeName) + 'UserData\';
  300. try
  301. if svDlg.Execute then
  302. begin
  303. if FileExists(svDlg.FileName) then
  304. begin
  305. if Application.MessageBox('文件已存在,是否覆盖?', '询问', MB_YESNO) = ID_NO then
  306. Exit;
  307. end;
  308. Screen.Cursor := crHourGlass;
  309. Selected.Data.Status := ufsDowning;
  310. sFile := svDlg.FileName;
  311. if PHPWeb.DownFile(Selected.Data.DownURL, sFile) then
  312. begin
  313. Selected.Data.Status := ufsNormal;
  314. end
  315. else
  316. begin
  317. Selected.Data.Status := ufsDownFail;
  318. end;
  319. end
  320. else
  321. Exit;
  322. finally
  323. svDlg.Free;
  324. Screen.Cursor := crDefault;
  325. end;
  326. end;
  327. constructor TUpFileManageView.Create(AOwner: TComponent);
  328. begin
  329. inherited;
  330. FRec := nil;
  331. lblBillName.Caption := '';
  332. lblBillName.Update;
  333. pnlDetail.Visible := G_IsCloud;
  334. end;
  335. procedure TUpFileManageView.DoOnBillChange(ARec: TsdDataRecord);
  336. begin
  337. FRec := ARec;
  338. with TProjectFrame(Owner) do
  339. begin
  340. if not (jpsAssistant.Visible and (jpsAssistant.ActivePage = jpsAssistantUpFile)) then
  341. Exit;
  342. end;
  343. RefreshBill;
  344. RefreshViews;
  345. end;
  346. procedure TUpFileManageView.SetRec(const Value: TsdDataRecord);
  347. begin
  348. FRec := Value;
  349. end;
  350. procedure TUpFileManageView.RefreshBill;
  351. var sCode: string;
  352. begin
  353. if FRec <> nil then
  354. begin
  355. if FRec.ValueByName('Code').AsString <> '' then
  356. sCode := FRec.ValueByName('Code').AsString
  357. else
  358. sCode := FRec.ValueByName('B_Code').AsString;
  359. if sCode <> '' then
  360. sCode := sCode + ' ';
  361. lblBillName.Caption := sCode + FRec.ValueByName('Name').AsString;
  362. end
  363. else
  364. lblBillName.Caption := '';
  365. lblBillName.Update;
  366. end;
  367. procedure TUpFileManageView.SelectUpFile;
  368. var vODlg: TOpenDialog;
  369. i, iBillID: Integer;
  370. vFile: TUpFile;
  371. sFile, sName: string;
  372. iV: Int64;
  373. begin
  374. vODlg := TOpenDialog.Create(nil);
  375. vODlg.Options := vODlg.Options + [ofAllowMultiSelect];
  376. if vODlg.Execute then
  377. begin
  378. for i := 0 to vODlg.Files.Count - 1 do
  379. begin
  380. sFile := vODlg.Files[i];
  381. iV := FileSizeByName(sFile);
  382. if iV >= 10485760 then
  383. begin
  384. Application.MessageBox(PChar('“' + sFile + '”过大,单个文件上传不能超过10M!'), '提示', MB_OK + MB_ICONINFORMATION);
  385. Continue;
  386. end;
  387. with MainForm.CurProjectFrame.dxsbViewControl do
  388. begin
  389. if SelectedItem = Groups[0].Items[0] then
  390. iBillID := TProjectData(FProjectData).BillsCompileData.BillsCompileTree.Selected.ID
  391. else if SelectedItem = Groups[0].Items[1] then
  392. iBillID := TProjectData(FProjectData).BillsMeasureData.BillsMeasureTree.Selected.ID;
  393. end;
  394. sName := ExtractFileName(sFile);
  395. vFile := Datas.Add(iBillID);
  396. vFile.Phase := TProjectData(FProjectData).PhaseIndex;
  397. vFile.OrgFile := sFile;
  398. vFile.Category := '台帐附件';
  399. vFile.Memo := '我的备注';
  400. vFile.LocalFile := Datas.Path + sName;
  401. vFile.DisplayName := sName;
  402. vFile.Status := ufsNeedUp;
  403. if G_IsCloud then
  404. begin
  405. // 添加到类→上传到服务器,生成ID→再到类中修改ID。为什么不先上传到服务器生成ID
  406. // 再添加到类并设置ID这样可以一气呵成呢?因为需要给用户一个交互界面让用户可以批量
  407. // 操作并决定取消某几个上传。这个交互界面的数据来自类。
  408. vFile.WebID := TProjectData(FProjectData).WebID;
  409. vFile.UperID := PHPWeb.UserID;
  410. vFile.UperName := PHPWeb.RealName;
  411. vFile.UpTime := FormatDateTime('yyyy-mm-dd hh:mm', Now);
  412. end
  413. else
  414. begin
  415. //
  416. end;
  417. AddUpFileView(vFile);
  418. end;
  419. end;
  420. Application.ProcessMessages;
  421. end;
  422. procedure TUpFileManageView.miLocalUpClick(Sender: TObject);
  423. begin
  424. SelectUpFile;
  425. end;
  426. end.