BMS-HOSxP Community
HOSxP => การเขียน SQL Script => ข้อความที่เริ่มโดย: armds ที่ กรกฎาคม 05, 2007, 14:05:52 PM
-
ขอคำแนะนำ script export DBF หน่อยครับ ทำตาม script export DBF ของอาจารย์ให้มาแล้ว
(อ้างอิงจาก Link http://hosxp.net/index.php?option=com_smf&Itemid=28&topic=1065.0 )
มี error มีข้อความว่า 'unit' expected but '1.' found.
1. unit Unit1;
2.
3. interface
4.
5. uses
6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7. Dialogs, ExtCtrls, StdCtrls, DB, DBClient, Grids, DBGrids, ComCtrls;
8.
9. type
10. TForm1 = class(TForm)
11. Panel1: TPanel;
12. Panel2: TPanel;
13. Panel3: TPanel;
14. DBGrid1: TDBGrid;
15. cds: TClientDataSet;
16. ds: TDataSource;
17. Button1: TButton;
18. Button2: TButton;
19. Button3: TButton;
20. Label1: TLabel;
21. cxDateEdit1: TcxDateEdit;
22. procedure Button1Click(Sender: TObject);
23. procedure Button2Click(Sender: TObject);
24. procedure Button3Click(Sender: TObject);
25. private
26. { Private declarations }
27. public
28. { Public declarations }
29. end;
30.
31. var
32. Form1: TForm1;
33.
34. implementation
35.
36. {$R *.dfm}
37.
38. function IMin(Val1, Val2: Integer): Integer;
39. begin
40. Result := Val1;
41. if Val2 < Val1 then
42. Result := Val2;
43. end;
44.
45. procedure AssignRecordx(Source, Dest: TDataSet; ByName: Boolean);
46.
47. var
48. I: Integer;
49. F, FSrc: TField;
50. begin
51.
52. if ByName then
53. begin
54. for I := 0 to Source.FieldCount - 1 do
55. begin
56. F := Dest.FindField(Source.Fields[I].FieldName);
57. if F <> nil then
58. begin
59. try
60. F.Value := Source.Fields[I].Value;
61. except
62. end;
63. end;
64. end;
65. end
66. else
67. begin
68. for I := 0 to iMin(Source.FieldDefs.Count - 1, Dest.FieldDefs.Count - 1) do
69. begin
70. F := Dest.FindField(Dest.FieldDefs[I].Name);
71. FSrc := Source.FindField(Source.FieldDefs[I].Name);
72. if (F <> nil) and (FSrc <> nil) then
73. begin
74. try
75. F.Value := FSrc.Value;
76. except
77. end;
78. end;
79. end;
80. end;
81. end;
82.
83. procedure TForm1.Button1Click(Sender: TObject);
84. begin
85. cds.data := hosxp_getdataset('select o.hn,o.vstdate,o.vsttime,p.pname,p.fname,p.lname ' +
86. ' from ovst o ' +
87. ' left outer join patient p on p.hn = o.hn ' +
88. ' where o.vstdate = "' + formatdatetime('yyyy-mm-dd', cxdateedit1.date) + '"');
89. end;
90.
91. procedure TForm1.Button2Click(Sender: TObject);
92. var dbf1: tdbf;
93. i: integer;
94. nf: boolean;
95. begin
96. dbf1 := tdbf.create(nil);
97. dbf1.close;
98. dbf1.tablelevel := 4;
99. dbf1.fielddefs.assign(cds.fielddefs);
100. repeat
101. nf := false;
102. for i := 0 to (dbf1.fielddefs.count - 1) do
103. begin
104. if not nf then
105. if (dbf1.fielddefs.items[i].datatype = ftTime) then
106. begin
107. dbf1.fielddefs.items[i].datatype := ftstring;
108. dbf1.fielddefs.items[i].size := 8;
109. nf := true;
110. end;
111. end;
112.
113. until not nf;
114.
115. dbf1.tablename := 'c:\dbase.dbf';
116. dbf1.createtable;
117. dbf1.open;
118. cds.first;
119. while not cds.eof do
120. begin
121.
122.
123. dbf1.append;
124. assignrecordx(cds, dbf1, true);
125. dbf1.post;
126. cds.next;
127. end;
128. dbf1.close;
129. dbf1.free;
130.
131. showmessage('Done.');
132.
133.
134. end;
135.
136. procedure TForm1.Button3Click(Sender: TObject);
137. begin
138. fcds.data := cds.data;
139. CreateDatasetReport('HOSxP Report');
140.
141. end;
142.
143. end.
-
เปลี่ยนระบบ script ใหม่ ครับ
-
รบกวนพี่อ๊อด แนะนำระบบ ส่งออก DBF จาก MySQL ว่าจะใช้รูปแบบไหนดีครับ คือผมจะแก้ไขไฟล์ที่ส่งออก 18 แฟ้ม ออกมาแล้ว แต่จะลบฟิวล์บางฟิวล์ที่ไม่เอา ออก แล้วส่งออกเป็น DBF ตามเดิม
ถ้าไงรบกวนชี้แนะด้วยครับ
-
ทำไมไม่เอา บางฟิล ครับ ไม่ได้เข้าใจ
ของ อ.ชัยพร ก็ครบ ตามโครงสร้าง provis และ phis แล้ว ส่วนที่เกิดมาก็ไม่ต้องไปสนใจก็ได้ครับ