startexe.bas

文件传送

Attribute VB_Name = "startEXE"
Option Explicit

Public port As Long '这是自定义的端口
Public port2 As Long


Public path As String  '保存路径的.因为考虑到可能处于根目录下.使用app.path有时会造成一些bug

Public tishi As Boolean  '是否在传输完毕时提示打开文件夹目录

Public mlngButtonStyle As Long  '按钮风格
Public mlngpbStyle2 As Long  '接收进度条风格
Public mlngpbStyle1 As Long  '发送进度条风格
Public mlngFormColor As Long  '颜色



Public Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long

'用来判断当前具得焦点的窗体句柄的API函数.用来判断自己的程序是否失去了焦点
Declare Function GetForegroundWindow Lib "user32" () As Long

'闪烁标题栏的API函数
Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long

'以默认打开方式打开文件的API函数
Declare Function ShellExecute Lib "SHELL32.DLL" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long





'这个自定义变量类型也是用作取得本机IP之用的

Public Const MAX_IP = 255
    Public Type IPinfo
     dwAddr As Long
     dwIndex As Long
     dwMask As Long
     dwBCastAddr As Long
     dwReasmSize As Long
     unused1 As Integer
     unused2 As Integer
    End Type
    Public Type MIB_IPADDRTABLE
     dEntrys As Long
     mIPInfo(MAX_IP) As IPinfo
    End Type
    Public Type IP_Array
     mBuffer As MIB_IPADDRTABLE
     BufferLen As Long
    End Type
Public strIP As String




'程序启动
Sub Main()

On Error GoTo err:


'判断是否处于根目录下.得到最后路径带"\"的程序所在路径
If Right(App.path, 1) <> "\" Then
    
    path = App.path & "\"
Else

    path = App.path
End If




'判断程序是否运行中
If App.PrevInstance = True Then

    If XMsgBox("此程序已经正在运行当中了,你是否想继续再次运行?", vbQuestion + vbYesNo + vbDefaultButton2, "发现程序已经在运行当中", ChartFrm.Picture1) _
    = vbNo Then
    
        End
        
    End If
    
    XMsgBox "同时运行两个程序可能会造成端口占用错误,请在项目按钮的下拉菜单中为这个程序重新指定一个新的使用端口", vbInformation, "请重新设定程序占用端口", ChartFrm.Picture3
    
End If



'可以在运行程序时接收command参数以指定端口号.可用可不用
If Command <> "" Then

    If CLng(Command) > 0 And CLng(Command) < 65535 Then

        port = CLng(Command)
        port2 = port + 1
        
    End If
    
Else

    port = 6843
    port2 = 6844
    
End If




mlngFormColor = CLng(myReadINI(path & "sendfile.ini", "Face", "FormColor", "14737632"))
mlngButtonStyle = CLng(myReadINI(path & "sendfile.ini", "Face", "buttonstyle", "3"))
mlngpbStyle1 = CLng(myReadINI(path & "sendfile.ini", "Face", "SdPBcolor", "0"))
mlngpbStyle2 = CLng(myReadINI(path & "sendfile.ini", "Face", "GtPBcolor", "3"))


'后面的代码访问了对象的属性.速度降低.
'可以用变量来代替后面的对象属性.


MainFrm.FileInFo.BackColor = mlngFormColor
ChartFrm.txtshow.BackColor = mlngFormColor
ChartFrm.BackColor = mlngFormColor


MainFrm.SDFilebrowse.ButtonType = mlngButtonStyle
MainFrm.SDFileStart.ButtonType = mlngButtonStyle
MainFrm.TCPconnect.ButtonType = mlngButtonStyle
MainFrm.Chart.ButtonType = mlngButtonStyle
ChartFrm.SendWord.ButtonType = mlngButtonStyle


If CLng(myReadINI(path & "sendfile.ini", "Option", "AutoCu", 0)) = 0 Then

    tishi = False
    
ElseIf CLng(myReadINI(path & "sendfile.ini", "Option", "AutoCu", 0)) = 1 Then

    tishi = True
    
End If


MainFrm.Show

Exit Sub

err:

'If err.Number = 13 Then

'    XMsgBox "请输入1-65534之间有效的数字以指定此程序的端口号!"
    port = 6843
    port2 = 6844
    
    MainFrm.Show
    
    Exit Sub
'End If

End Sub



'以下这两个过程为取得本机的IP信息之用



Public Function ConvertAddressToString(longAddr As Long) As String
     Dim myByte(3) As Byte
     Dim cnt As Long
     CopyMemory myByte(0), longAddr, 4
     For cnt = 0 To 3
     ConvertAddressToString = ConvertAddressToString + CStr(myByte(cnt)) + "."
     Next cnt
     ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function
     
Public Sub Start()
     Dim Ret As Long, Tel As Long
     Dim bBytes() As Byte
     Dim Listing As MIB_IPADDRTABLE
     On Error GoTo END1
     GetIpAddrTable ByVal 0&, Ret, True
     If Ret <= 0 Then Exit Sub
     ReDim bBytes(0 To Ret - 1) As Byte
     GetIpAddrTable bBytes(0), Ret, False
     CopyMemory Listing.dEntrys, bBytes(0), 4
     strIP = "在你机器上共有 " & Listing.dEntrys & " 个 IP 地址。" & vbCrLf
     strIP = strIP & "--------------------------------------" & vbCrLf & vbCrLf
     For Tel = 0 To Listing.dEntrys - 1
     CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))
     strIP = strIP & "IP 地址 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) & vbCrLf
     strIP = strIP & "子网掩码 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwMask) & vbCrLf
     strIP = strIP & "广播地址 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwBCastAddr) & vbCrLf
     strIP = strIP & "--------------------------------------" & vbCrLf
     Next
     Exit Sub
END1:
     XMsgBox "取得本机IP地址出错", , "错误", ChartFrm.Picture2
End Sub