📄 frmupload.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Begin VB.Form frmUpload
BorderStyle = 1 'Fixed Single
Caption = "媒体文件上传"
ClientHeight = 4395
ClientLeft = 45
ClientTop = 330
ClientWidth = 7110
Icon = "frmUpload.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4395
ScaleWidth = 7110
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdStop
Caption = "停止 [F9]"
Enabled = 0 'False
Height = 390
Left = 2700
TabIndex = 7
Tag = "确定"
Top = 3780
Width = 1320
End
Begin MSComctlLib.ProgressBar pbrUpload
Height = 195
Left = 180
TabIndex = 6
Top = 3840
Width = 2295
_ExtentX = 4048
_ExtentY = 344
_Version = 393216
Appearance = 1
End
Begin VB.Frame Frame1
Caption = "记录选择"
Height = 735
Left = 180
TabIndex = 3
Top = 360
Width = 6735
Begin VB.CommandButton Command1
Caption = "刷新"
Height = 330
Left = 5580
TabIndex = 8
Tag = "确定"
Top = 240
Width = 960
End
Begin VB.OptionButton optAll
Caption = "所有未上传记录"
Height = 255
Left = 300
TabIndex = 5
Top = 300
Value = -1 'True
Width = 1755
End
Begin VB.OptionButton optToday
Caption = "当天未上传记录"
Height = 255
Left = 2160
TabIndex = 4
Top = 300
Width = 1935
End
End
Begin MSDataGridLib.DataGrid dgX
Height = 2295
Left = 180
TabIndex = 2
Top = 1260
Width = 6735
_ExtentX = 11880
_ExtentY = 4048
_Version = 393216
HeadLines = 1.3
RowHeight = 17
FormatLocked = -1 'True
BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ColumnCount = 6
BeginProperty Column00
DataField = "US_NO"
Caption = "放射号"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = "FILE_NAME"
Caption = "文件名"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column02
DataField = "SOUND_FILE_NAME"
Caption = "配音文件名"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column03
DataField = "FILE_TYPE"
Caption = "文件类型"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column04
DataField = "UPLOADED"
Caption = "上传"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column05
DataField = "SERIAL_ID"
Caption = "序号"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
ColumnWidth = 1124.787
EndProperty
BeginProperty Column01
ColumnWidth = 2129.953
EndProperty
BeginProperty Column02
ColumnWidth = 1665.071
EndProperty
BeginProperty Column03
ColumnWidth = 1080
EndProperty
BeginProperty Column04
Object.Visible = 0 'False
EndProperty
BeginProperty Column05
Object.Visible = 0 'False
EndProperty
EndProperty
End
Begin VB.CommandButton cmdExit
Caption = "退出 [ESC]"
Height = 390
Left = 5580
TabIndex = 1
Tag = "取消"
Top = 3780
Width = 1320
End
Begin VB.CommandButton cmdOK
Caption = "开始 [Enter]"
Height = 390
Left = 4140
TabIndex = 0
Tag = "确定"
Top = 3780
Width = 1320
End
End
Attribute VB_Name = "frmUpload"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ani As New SysAnimate32
Private Const RES_AVI = 101
Dim rsUnUploadedRecords As ADODB.Recordset '未上传的记录集
Dim bForceStop As Boolean '在上传过程中中止的信号
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
'退出计算过程
'ani.pPlay
'---------------------------------------------------------------
'遍历记录以上传, 注意在上传之前要多作一些检验工作防止出现意外
'---------------------------------------------------------------
On Error GoTo ErrHandle:
Dim strFile As String
Dim iCount As Long, iPos As Long
With rsUnUploadedRecords
'检验记录集是否为空
If .EOF And .BOF Then
Exit Sub
End If
'检验服务器路径是否存在
If FSO.FolderExists(gstrServerImageDir) = False Then
MsgBox "服务器路径不存在! 请检查网络的状态和服务器路径设置是否正确。", vbExclamation + vbOKOnly, "提示"
Exit Sub
End If
.MoveFirst
iCount = .RecordCount
cmdStop.Enabled = True
Do While Not .EOF
'strFile = ChangeFilePath(!FILE_NAME, gstrImageDir) '获取图像文件名称
strFile = !FILE_NAME '参照修改意见更改，更好的方法再议
If FSO.FileExists(strFile) Then
FSO.CopyFile strFile, ChangeFilePath(strFile, gstrServerImageDir) '复制文件
!UPLOADED = True
End If
iPos = IIf(iPos >= iCount, iCount, iPos + 1) 'iPos不能大于iCount,否则会出错
pbrUpload.Value = 100 * iPos / iCount
.MoveNext
If bForceStop Then
Exit Sub
End If
DoEvents
Loop
End With
MsgBox "媒体文件上传完成!", vbOKOnly + vbInformation, "提示"
cmdStop.Enabled = False
pbrUpload.Value = 0
Exit Sub
ErrHandle:
ShowError
Exit Sub
Resume
End Sub
Private Sub cmdStop_Click()
'----------------------------
'发出强制中止的信号
'----------------------------
bForceStop = True
End Sub
Private Sub Form_Load()
'开始动画
'ani.Create Me.hwnd, RES_AVI, 21, 17, 260, 40
ShowUnUploadedRecords
End Sub
Private Sub Form_Unload(Cancel As Integer)
'退出时关闭动画
ani.pStop
ani.Destroy
End Sub
Private Sub ShowUnUploadedRecords()
'-----------------------------------
'显示未上传的记录
'-----------------------------------
Dim strSQL As String
strSQL = "SELECT US_MEDIA.*, US_REPORT.DIAG_DAY, US_REPORT.US_NO FROM US_REPORT INNER JOIN US_MEDIA ON US_REPORT.US_NO = US_MEDIA.US_NO Where US_MEDIA.UPLOADED = 0 And US_REPORT.WORKSTATION_ID = " & SingleQuote(gstrWorkStationID)
Set rsUnUploadedRecords = OpenRSClient(strSQL, "Data")
Select Case True
Case optAll.Value
rsUnUploadedRecords.Filter = vbNullString
Case optToday.Value
rsUnUploadedRecords.Filter = "US_REPORT.DIAG_DAY = " & SingleQuote(Date)
End Select
Set dgX.DataSource = rsUnUploadedRecords
dgX.Refresh
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -