| |
|
|
| | как проверит потклчён ли аксс к MS SQL 2008 R2 если нет то запустить ярлык VPN потключения ? | |
| |
| |
| |
|
|
| |
Option Compare Database
Option Explicit
Private 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
Function callvpn()
Dim cnn As Object
Set cnn = CreateObject("ADODB.Connection")
cnn.Open "DSN=p;UID=sa;PWD=000000;"
If cnn.State = adStateOpen Then
cnn.Close
Exit Function
Else
Call ShellExecute(0, vbNullString, "d:\post\temp\vpn\d.lnk", vbNullString, vbNullString, vbNormalFocus)
End If
End Function
|
работает но прога завсает примерно 30 сек | |
| |
| |
| |
|
|
| | как по другому проверить б\д потклёчина к SQL или нет | |
| |
| |
| |
|
|
| | как я понимаю некто некогда н проверал потключена ли база к SQL | |
| |
| |
| |
|
|
| | Сегодня просто - выходной день, однако. | |
| |
| |
| |
|
|
| | А сегодня просто - понеделник | |
| |
| |
| |
|
|
| | у меня к ораклу так
Public Function conn2dbasync(unm$, ppw$, Optional ccon& = 0)
Dim lngStartTime As Long
On Error GoTo err123
conn2dbasync = 0
If ccon = 0 Then
If conn.State <> 0 Then conn.Cancel: Set conn = Nothing ': conn.Close
Else
If conn.State = 1 Then conn2dbasync = 1: Exit Function
End If
Set conn = New ADODB.Connection
conn.ConnectionTimeout = 30
conn.CursorLocation = adUseClient
conn.ConnectionString = "<моя строка>"
conn.Open , , , adAsyncConnect
lngStartTime = GetTickCount()
Do While ((GetTickCount() - lngStartTime) < conn.ConnectionTimeout * 1000) And (Not conn.State = adStateOpen): Loop
If Not conn.State = adStateOpen Then
If conn.State = adStateConnecting Then
conn.Cancel
End If
Else
Call set_priv
If conn.State = 0 And conn.Errors.Count > 0 Then Exit Function
conn2dbasync = conn.State
End If
Exit Function
err123:
MsgBox Error & IIf(conn.Errors.Count > 0, vbCrLf & conn.Errors.Item(0).Description, ""), , "conn2dbasync"
Exit Function
End Function
|
имхо, зависает, потому что надо асинхронный режим использовать (adAsyncConnect) | |
| |
| |
|
|
| |
|
|
| | как я понимаю это тоже с кодом идёт ?
Declare Function GetTickCount32 Lib "KERNEL32" _
Alias "GetTickCount" () As Long
Declare Function GetTickCount16 Lib "User" Alias _
"GetTickCount" () As Long
Function GetTickCount() As Long
If Engine32%() Then
GetTickCount = GetTickCount32()
Else
GetTickCount = GetTickCount16()
End If
End Function
Function Engine32%()
If SysCmd(7) > 2 Then Engine32% = True
End Function
|
| |
| |
| |
| |
|
|
| | unm$, ppw$, Optional ccon& = 0 и это не нужно? | |
| |
| |
| |
|
|
| | юзернэйм, пароль
это для в строке подключения использования
а это
параметр для обнуления коннекшина | |
| |
| |
|
|
| |
|
|
| | вроде тоже самое зависает(( | |
| |
| |
| |
|
|
| | или я что-то не правильно делаю  | |
| |
| |
| |
|
|
| | пошагово попробуй - увидь где зависает
в любом случае, чтобы приложение не подвисало - надо подключаться в асинхронном режиме | |
| |
| |
| |
|
|
| |
надо подключаться в асинхронном режиме
|
как это? | |
| |
| |
| |
|
|
| |
Do While ((GetTickCount() - lngStartTime) < conn.ConnectionTimeout * 1000) And (Not conn.State = adStateOpen): Loop
|
здесь пауза примерно в 30 - 40 сек | |
| |
| |
| |
 159 Кб. |
|
| |
If Not conn.State = adStateOpen Then
|
или здес короче когда потключаеца к удалёный бд
в ODBC есть такая кнопка но как к ней через вба потключица (( | |
| |
| |
| |
|
|
| | А зачем так на долго задан таймаут
Do While ((GetTickCount() - lngStartTime) < conn.ConnectionTimeout * 1000) And (Not conn.State = adStateOpen): Loop | |
| |
| |
| |
|
|
| | ну у меня так задан :)) а чё? ;)) | |
| |
| |
| |
|
|
| | ну у меня так задан :)) а чё? ;))
===========================
Ды не ни чё проста спрасил..... | |
| |
| |
| |
|
|
| | я не черес одєбєцє
я черес MSDAORA  | |
| |
| |
| |
|
|
| | здесь, для асинхронного режима сделано так :)) или какоето время ждёт коннекшина от сервера отклика :) или пока сервер не скажет что conn.State = adStateOpen :)
просто при асинхронній режим приложение не задержуецца а дальше
а ті уже сам отловить должен факт | |
| |
| |
| |
|
|
| | conn.Open , , , adAsyncConnect
посмотри параметрі коннекшнопена | |
| |
| |
| |
|
|
| | для эмэсскула тоже есть , токо дома  | |
| |
| |
|
|
| |
|
|
| | я табе абманул у меня тама ADP
а через ОДБЦ просто таблы поподключал к базе и все
но с ораклом уже через адодэбэ
смски отправлял через freemail.dll | |
| |
| |
| |
|
|
| | Понятно а случайно дома нету кода чтоб потключица к ОДБС ? | |
| |
| |
| |
|
|
| |
'-- далее, в зависимости от типа настройки
Select Case .Fields("lnkType")
'-- Link ODBC----------------------------------------------------------
Case 3
If .Fields("dstPath") = "CurrentDB" Then
Set dbd = cbd
Else
Set dbd = DBEngine.Workspaces(0).OpenDatabase(.Fields("dstPath"))
End If
'-- удалить связь
On Error Resume Next
dbd.TableDefs.Delete .Fields("lnkNam")
dbd.TableDefs.Refresh
On Error GoTo ErrRefreshLinkTables
'-- создать по новой, если bLink<>0
If .Fields("bLink") <> 0 And .Fields("aLink") <> 0 Then
Set dtf = dbd.CreateTableDef(.Fields("lnkNam"))
'--"ODBC;DSN=<ВашСервер>;UID=UserID;PWD=PASSWORD;DATABASE=DBNAME;AutoTranslate=No"
dtf.Connect = .Fields("srcPath")
dtf.SourceTableName = .Fields("objNam")
'добавляем таблицу в семейство TableDefs
dbd.TableDefs.Append dtf
dbd.TableDefs.Refresh
End If
|
| |
| |
| |
| |
|
|
| | шас попрбую  | |
| |
| |
