VB做的邮件称重拍照记录工具.docx
《VB做的邮件称重拍照记录工具.docx》由会员分享，可在线阅读，更多相关《VB做的邮件称重拍照记录工具.docx（26页珍藏版）》请在冰豆网上搜索。
VB做的邮件称重拍照记录工具
邮件称重拍照记录工具
iamlaosong文
做了一个邮件重量稽核工具，即在集散中心随机抽取一定量的邮件，进行重量复核并记录在案。
工具本身没什么新技术，但用到的技术比较多，如Excel文件操作、INI文件的读取、串口通信、拍照、图像格式转换、网页抓取等。
工具操作很简单，将邮件放到电子秤上，用扫描枪扫描条码后，计算机完成抓取实际重量、抓取收寄重量（根据邮件号码上网站抓取）、拍照（摄像头对准邮件和电子秤）、保存为JPG格式、增加图片链接、数据保存到Excel文件、显示本邮件的重量误差等一系列工作，然后换上新邮件重复上面的工作。
工具界面如下：
上面说的是主要功能，还有些辅助功能，如取重测试、拍照测试、重量比较（就是批量到网站抓取邮件收寄重量）等。
正常工作时界面如下：
下面是工具的完整代码：
[vb] viewplain copy
1.'读取INI文件的API（读、写字符串和读数字）
2.Private Declare Function GetPrivateProfileString Lib "kernel32" Alias _
3. "GetPrivateProfileStringA" （ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
4. ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, _
5. ByVal lpFileName As String） As Long
6.Private Declare Function WritePrivateProfileString Lib "kernel32" Alias _
7. "WritePrivateProfileStringA" （ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
8. ByVal lpString As Any, ByVal lpFileName As String） As Long
9.Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias _
10. "GetPrivateProfileIntA" （ByVal lpApplicationName As String, ByVal lpKeyName As String, _
11. ByVal nDefault As Long, ByVal lpFileName As String） As Long
12.
13.'拍照必需的API
14.Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias _
15. "capCreateCaptureWindowA" （ByVal lpszWindowName As String, ByVal dwStyle As Long, _
16. ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
17. ByVal hWndParent As Long, ByVal nID As Long） As Long
18.
19.Private Const WS_CHILD = &H40000000
20.Private Const WS_VISIBLE = &H10000000
21.Private Const WM_USER = &H400
22.Private Const WM_CAP_START = &H400
23.Private Const WM_CAP_EDIT_COPY = （WM_CAP_START + 30）
24.Private Const WM_CAP_DRIVER_CONNECT = （WM_CAP_START + 10）
25.Private Const WM_CAP_SET_PREVIEWRATE = （WM_CAP_START + 52）
26.Private Const WM_CAP_SET_OVERLAY = （WM_CAP_START + 51）
27.Private Const WM_CAP_SET_PREVIEW = （WM_CAP_START + 50）
28.Private Const WM_CAP_DRIVER_DISCONNECT = （WM_CAP_START + 11）
29.Private Preview_Handle As Long
30.
31.Private Declare Function SendMessage Lib "user32" Alias _
32."SendMessageA" （ByVal hwnd As Long, ByVal wMsg As Long, _
33.ByVal wParam As Long, lParam As Any） As Long
34.'===========================end
35.
36.'用GDI+保存图片为JPG、TIFF、PNG、GIF、BMP等格式的API
37.Private Type GUID
38. Data1 As Long
39. Data2 As Integer
40. Data3 As Integer
41. Data4（0 To 7） As Byte
42.End Type
43.Private Type GdiplusStartupInput
44. GdiplusVersion As Long
45. DebugEventCallback As Long
46. SuppressBackgroundThread As Long
47. SuppressExternalCodecs As Long
48.End Type
49.Private Type EncoderParameter
50. GUID As GUID
51. NumberOfValues As Long
52. type As Long
53. Value As Long
54.End Type
55.Private Type EncoderParameters
56. count As Long
57. Parameter As EncoderParameter
58.End Type
59.
60.Private Declare Function GdiplusStartup Lib "GDIPlus" （token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0） As Long
61.Private Declare Function GdiplusShutdown Lib "GDIPlus" （ByVal token As Long） As Long
62.Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" （ByVal hbm As Long, ByVal hPal As Long, BITMAP As Long） As Long
63.Private Declare Function GdipDisposeImage Lib "GDIPlus" （ByVal Image As Long） As Long
64.Private Declare Function GdipSaveImageToFile Lib "GDIPlus" （ByVal Image As Long, ByVal FileName As Long, clsidEncoder As GUID, encoderParams As Any） As Long
65.Private Declare Function CLSIDFromString Lib "ole32" （ByVal Str As Long, id As GUID） As Long
66.Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" （Dest As Any, Src As Any, ByVal cb As Long） As Long
67.'===========================end
68.
69.'公共变量
70.Dim xlApp As Excel.Application
71.Dim xlBook As Excel.Workbook
72.Dim xlSheet As Excel.Worksheet
73.
74.Dim modFile, datPath, datFile, datFullName, SerialPort, picPath, OperateMode, TimeOut, TrackUrl As String
75.Dim Maxrow, Total As Integer
76.Dim CurDate As Date
77.'作为函数的参数变量要单独定义
78.Dim EmsCode As String
79.
80.
81.'拍摄图片测试
82.Private Sub CmdPicTest_Click（）
83. '拍摄图片
84. Image1.Picture = CapturePicture（Preview_Handle）
85. '保存图片
86. If Image1.Picture <> 0 Then
87. SavePicture Image1.Picture, App.Path & "\PicTest.bmp"
88. Else
89. MsgBox "摄像头无效，请检查！
", vbOKOnly, "iamlaosong"
90. End If
91. SavePic Image1.Picture, App.Path & "\PicTest.jpg", ".jpg"
92.
93.End Sub
94.
95.
96.'初始化
97.Private Sub Form_Load（）
98. '界面初始化，显示版本信息
99. Form1.Caption = Form1.Caption & "--邮政速递安徽省分公司 Ver:
iamlaosong-20160706"
100. CurDate = Date
101. LabNumber.Caption = CurDate
102. '读取参数
103. modFile = GetIniStr（"Modfile", "重量记录模板.xls"）
104. datPath = GetIniStr（"Datpath", App.Path） '数据保存路径
105. TimeOut = GetIniStr（"TimeOut", "0"） '串口通信超时，0表示不设置超时
106. If Dir（datPath, vbDirectory） = vbNullString Then
107. MkDir datPath '创建文件夹
108. End If
109. If Right（datPath, 1） <> "\" Then datPath = datPath & "\"
110.
111. TrackUrl = GetIniStr（"Http", "http:
//10.3.10.83/ems/"）
112. WebBrowser1.Visible = True
113. WebBrowser1.Navigate TrackUrl
114.
115. SerialPort = GetIniStr（"Device", "COM1"）
116. OperateMode = GetIniStr（"Mode", "1"）
117. '设置串口
118. SetComm
119. '摄像头初始化
120. SetViedo
121.End Sub
122.
123.'日期调整
124.Private Sub CmdDate_Click（Index As Integer）
125. If Index = 0 Then
126. CurDate = CurDate + 1
127. Else
128. CurDate = CurDate - 1
129. End If
130. LabNumber.Caption = CurDate
131.End Sub
132.
133.'开始扫描称重，如当天的记录文件存在，则继续添加
134.Private Sub CmdBegin_Click（）
135.
136. Set xlApp = CreateObject（"Excel.Application"） '创建EXCEL对象
137. '检查记录文件
138. datFile = Format（CurDate, "yyyymmdd"） & modFile
139. datFullName = datPath & datFile
140. If Dir（datFullName, vbNormal） = vbNullString Then
141. FileCopy App.Path & "\" & modFile, datFullName ' 将源文件的内容复制到目的文件中。
142. End If
143. '检查图像目录
144. picPath = datPath & "Pic" & Format（CurDate, "yyyymmdd"）
145. If Dir（picPath, vbDirectory） = vbNullString Then
146. MkDir picPath '创建文件夹
147. End If
148.
149.
150. '打开记录文件
151. Set xlBook = xlApp.Workbooks.Open（datFullName） '打开文件
152. 'xlApp.Visible = True '设置EXCEL对象可见（或不可见）
153. 'Set xlSheet = xlBook.Worksheets（"表名"） '设置活动工作表
154. Total = 0
155. Set xlSheet = xlBook.Worksheets
（1） '设置活动工作表
156. Maxrow = xlSheet.Cells（65536, 2）.End（xlUp）.Row
157. If xlBook.ReadOnly = True Then
158. xlBook.Close
159. xlApp.Quit '结束EXCEL对象
160. Set xlApp = Nothing '释放xlApp对象
161. MsgBox "文件<" & datFile & ">已打开，请先关闭！
", vbOKOnly, "iamlaosong"
162. Else
163.
164. '打开串口
165. MSComm1.InBufferCount = 0 '清除接收缓冲区
166. If Not MSComm1.PortOpen Then
167. MSComm1.PortOpen = True '打开通信端口
168. End If
169. '打开输入框
170. TxtCode.Enabled = True
171. TxtWeight.Enabled = True
172. CmdDate（0）.Visible = False
173. CmdDate
（1）.Visible = False
174.
175. TxtCode.Text = ""
176. TxtWeight.Text = ""
177. CmdEnd.Enabled = True
178. LabState.Caption = "邮件记录：
"
179. LabNumber.FontSize = LabState.FontSize + 2
180. LabNumber.Caption = Total
181.
182. TxtCode.SetFocus
183. End If
184.
185.End Sub
186.
187.
188.'退出（按回车）重量文本框记录一条邮件信息
189.Private Sub TxtCode_KeyPress（KeyAscii As Integer）
190. Dim Err As Boolean
191.
192. If KeyAscii = 13 Then
193. EmsCode = TxtCode.Text
194. If ChkCode.Value = Checked Then
195. '判断号码是否规范
196. If Len（EmsCode） = 13 Then
197. Err = Not ChkMailCode（EmsCode） '检查邮件号码是否正常（正常时返回True）
198. Else
199. Err = True
200. End If
201. If Err Then
202. MsgBox "经校验，邮件号码有误！
", vbOKOnly, "iamlaosong"
203. Else
204. Err = ChkMailDuplicate（EmsCode）
205. If Err Then
206. MsgBox "经检查，邮件号码重复！
", vbOKOnly, "iamlaosong"
207. TxtCode.SelStart = 0
208. TxtCode.SelLength = Len（TxtCode.Text）
209. TxtCode.SetFocus
210. Exit Sub
211. End If
212. End If
213. If Err Then
214. TxtCode.SelStart = 0
215. TxtCode.SelLength = Len（TxtCode.Text）
216. TxtCode.SetFocus
217. Exit Sub
218. End If
219. End If
220. If OperateMode = "1" Then
221. CmdGetweight_Click
222. Else
223. TxtWeight.Text = ""
224. CmdGetweight.SetFocus
225. End If
226. End If
227.End Sub
228.
229.'退出（按回车）重量文本框记录一条邮件信息----用于手工录入重量
230.Private Sub TxtWeight_KeyPress（KeyAscii As Integer）
231. If KeyAscii = 13 Then
232. '保存一条记录
233. Maxrow = Maxrow + 1
234. xlSheet
升级会员 