'--------------------------------主数据库-------------------------------
Dim cn As String = "Provider=SQLOLEDB.1;Password={0};Persist Security Info=True;User ID={1};Initial Catalog=bydata;Data Source={2}"
Dim sql As String = FileSys.ReadAllText(ProjectPath & "Attachments\SqlServers.sipcg")
Dim sarr() As String = sql.Replace(vbcr,"").Split(vblf)
Dim sdt As Date = Date.Now
Dim Sum As Integer
Forms("启动连接").Open
Dim se As WinForm.PictureBox = Forms("启动连接").Controls("PictureBox1")
se.Image = qd
Dim sqlqtu As WinForm.Label = Forms("启动连接").Controls("Label2")
sqlqtu.text = "正在连接数据源,请稍后.... "
Application.DoEvents
For i As Integer = 0 To 1
Dim tsq1 As String
Dim tsq2 As String
Dim tsq3 As String
Dim jzf1 As String = sarr(i*3).SubString(9)
Dim jzf3 As String = sarr(i*3+1).SubString(8)
Dim jzf5 As String = sarr(i*3+2).SubString(12)
tsq1 = jzf1.Trim()
tsq2 = jzf3.Trim()
tsq3 = jzf5.Trim()
Dim Val1 As String = DecryptText(tsq1,"slp","shby")
Dim Val3 As String = DecryptText(tsq2,"slp","shby")
Dim Val5 As String = DecryptText(tsq3,"slp","shby")
Dim exp As String = CExp(cn,Val1,Val3,Val5)
Dim ErrMsg As String
Dim sqlqd As WinForm.Label = Forms("启动连接").Controls("Label1")
sqlqd.text = "正在连接数据源: " & Val5 '追加数据代码
Application.DoEvents
If Connections.TryConnect(exp,ErrMsg) = True Then
For iy As Integer = 1 To 1
Connections.Add("彬阳数据",exp)
sqlqd.text = Val5 & " 数据源加载成功!准备用户登入!"
Application.DoEvents
While Date.Now < sdt.AddSeconds(2)
End While
Forms("启动连接").Close()
Next
Forms("用户登录").Open()
If _UserName = "" Then
Syscmd.Project.Exit()
Return Nothing '这个要加上,因为既然要退出,就不应该再执行后面的初始化代码了,否则会出错
End If
Exit For
Else
Sum = Sum + i
If sum = 0 Then
sqlqd.text = Val5 & " 数据源未加载成功!准备使用备用地址加载数据源!"
Application.DoEvents
While Date.Now < sdt.AddSeconds(1)
End While
End If
If Sum = 1 Then
sqlqd.text = Val5 & " 数据源未加载成功!准备使用备用地址加载数据源!"
Application.DoEvents
While Date.Now < sdt.AddSeconds(1)
End While
Forms("启动连接").Close()
Forms("SQL提示").Open()
Dim sqlts As WinForm.Label = Forms("SQL提示").Controls("Label1")
sqlts.text = Val5 & " 数据源无法连通!是否需要数据库连接设置?"& (vbcrlf)& ErrMsg '追加数据代码
Return Nothing
End If
End If
Next
'----------------------------------FTP信息------------------------------
'''
Dim sf As String = FileSys.ReadAllText(ProjectPath & "Attachments\ftpip.ipls")
Dim arrs() As String = sf.Replace(vbcr,"").Split(vblf)
Forms("启动连接").open
Dim ftpqtu As WinForm.Label = Forms("启动连接").Controls("Label2")
ftpqtu.text = "正在连接FTP,请稍后.... "
Application.DoEvents
For i As Integer = 0 To 1
Dim sqlqd As WinForm.Label = Forms("启动连接").Controls("Label1")
Dim ftp0 As New FTPClient
Dim tsq1 As String
Dim tsq2 As String
Dim tsq3 As String
Dim jzf1 As String = arrs(i*3).Split("|")(1)
Dim jzf3 As String = arrs(i*3+1).Split("|")(1)
Dim jzf5 As String = arrs(i*3+2).Split("|")(1)
tsq1 = jzf1.Trim()
tsq2 = jzf3.Trim()
tsq3 = jzf5.Trim()
Dim Val1 As String = DecryptText(tsq1,"slp","shby")
ftp0.password = Val1
Dim Val3 As String = DecryptText(tsq2,"slp","shby")
ftp0.Account = Val3
Dim Val5 As String = DecryptText(tsq3,"slp","shby")
ftp0.host = Val5
sqlqd.text = "正在连接FTP地址: " & ftp0.host '追加数据代码
Application.DoEvents
If ftp0.Connect Then
sqlqd.text = ftp0.host & "该FTP服务器可正常使用!" '追加数据代码
Application.DoEvents
While Date.Now < sdt.AddSeconds(2)
End While
Forms("启动连接").Close()
For iy As Integer = 1 To 1
Dim ftp1 As New FTPClient
ftp1.host =ftp0.host
Tables("FTPIP").Current("FTPhost") = ftp0.host
ftp1.Account = ftp0.Account
Tables("FTPIP").Current("FTPAccount") = ftp0.Account
ftp1.password = ftp0.password
Tables("FTPIP").Current("FTPpassword") = ftp0.password
Next
If DataTables("FTPIP").HasChanges Then
DataTables("FTPIP").Save()
End If
Exit For
Else
Sum = Sum + i
If sum = 0 Then
sqlqd.text = ftp0.host & " FTP服务器未连接成功!准备使用备用地址连接!"
Application.DoEvents
While Date.Now < sdt.AddSeconds(2)
End While
End If
If Sum = 1 Then
sqlqd.text = ftp0.host & "该FTP服务器不可用!"
Application.DoEvents
While Date.Now < sdt.AddSeconds(2)
End While
Forms("启动连接").Close()
End If
End If
Next
'-----------------------------------------------------------------------
加好友 
发短信
Post By：2019/2/12 21:25:00 [显示全部帖子]
此主题相关图片如下：无法显示.jpg
