VB 6.0 - invalid authorization specification - Asked By madhavi on 13-Jan-12 01:58 AM

"runtime error 2147467259(80004005) invalid authorization specification"

any one plz help me.its very urgent.
fir ur refernce i paste my code here..


' Library :
'  Program Utilities (util.dll)

'*****************************************
'Global Variable
'*****************************************
Option Explicit

' Action Mode
Public Enum EnumAct
    actNon = 0   ' Perform Nothing
    actAdd = 1   ' Add Mode
    actEdit = 2    ' Edit Mode
    actDel = 3   ' Delete Mode
    actSave = 4   'Save
    actCancel = 5   'Cancel
    actRefresh = 7  'Refresh
    actList = 9   'List
End Enum

' Query Mode
Public Enum EnumQry
    qryNon = 0   ' Perform Nothing
    qrySetTo = 1    ' Goto Mode
    qryFilter = 2  ' Filter Mode
End Enum

Global UserID As String
Global UserLvl As String

Global FundCode As String
Global BranchCode As String
Global PgmPath As String
Global MsgPath As String
Global AppPath As String
Global ImgPath As String
Global DebugPrg As Boolean

Global PCnn As String
Global PAUsr As String
Global Pspwd As String
Global PCmpy As String
Global gProgramID As String

' Account Position
Global posAcc As Integer
Global posPlan As Integer
Global posFCd As Integer
Global posDgt As Integer

Global AccFmt As String
Global AccMask As String

' Colour - Header, Detail, HGrid
Global colorHdr As ColorConstants
Global colorDtl As ColorConstants
Global colorGrid As ColorConstants

Global cn As New ADODB.Connection

Public Sub Main()
    Dim colorTmp As String
    Dim a As New clsEncryptDecrypt
   
    If AppLoaded Then
    Exit Sub
    End If
   
   
    ' ** Registry Value **
    ' Connection
    PCnn = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "CnnUH")
    PAUsr = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "Svrusr")
    Pspwd = util.GetString(util.HKEY_LOCAL_MACHINE, "software\rbs\Toms", "Svrpwd")
    If Trim(Pspwd) <> "" Then
    Pspwd = a.DecryptText(Trim(Pspwd))
    End If
   
    Call GetCnn
 
    ' get company title
    PCmpy = util.GetString(util.HKEY_LOCAL_MACHINE, "software\rbs\Toms", "Company")
   
    ' Account format
    AccFmt = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "AccFmt")
    AccMask = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "AccMask")
   
    posAcc = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "posAcc")
    posPlan = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "posPlan")
    posFCd = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "posFCd")
    posDgt = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "posDgt")
   
    colorHdr = Val(util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "colorHdr"))
    colorDtl = Val(util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "colorDtl"))
    colorGrid = Val(util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "colorGrid"))
   
    DebugPrg = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\RBS\Setting", "DebugPrg") = "Y"
    PgmPath = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\RBS\Toms", "Program Path")
   
    'If DebugPrg Then
    '    AppPath = App.Path & "\.."
    'Else
    '    AppPath = App.Path
    'End If
   
    ' Infomation file values (.ini)
    AppPath = PgmPath & "\UH"
    'AppPath = PgmPath & "\uh new"    'temporary - testing
    MsgPath = PgmPath & "\UHMsg.ini"
    ImgPath = PgmPath & "\Qimg"

    ' Parameter Values
    UserID = GetPara(Command, "User") ' util.StrBlock(Command, 1, "|")
    FundCode = GetPara(Command, "Fund") ' util.StrBlock(Command, 2, "|")
    BranchCode = GetPara(Command, "Branch") ' util.StrBlock(Command, 3, "|")
    gProgramID = GetPara(Command, "Program")

    Call StartProgram
   
End Sub
Public Function Ppara()
    Ppara = " ;User " & Trim(UserID) & " ;Fund " & Trim(FundCode) & " ;Branch " & Trim(BranchCode) & " ;Program " & Trim(gProgramID)
End Function

Public Function GetCnn()
  
    If cn.State = adStateOpen Then GoTo EndCnn

    'Connection
    cn.Open PCnn, Trim$(PAUsr), Trim$(Pspwd)
    cn.CommandTimeout = 0
    cn.CursorLocation = adUseClient
   
EndCnn:

End Function

Private Function AppLoaded() As Boolean
    Const scMSg = " is already running, only one instance of program is allowed."
    AppLoaded = False
   
    If App.PrevInstance Then
    AppLoaded = True
    MsgBox App.ProductName & scMSg, vbCritical
    Exit Function
    End If

End Function

Public Function GetPara(sPara, sKey As String) As String
    Dim s As String
    Dim s2 As String
    Dim Pos1 As Integer
    Dim Pos2 As Integer
   
    s = ";" & UCase(sKey)
    s2 = UCase(sPara) & ";"
   
    Pos1 = 1
    Pos1 = InStr(Pos1, s2, s)
   
    If Pos1 = 0 Then
    GetPara = ""
    Exit Function
    End If
   
    Pos2 = Pos1 + 1
    Pos2 = InStr(Pos2, s2, ";")
   
    GetPara = Trim(Mid(sPara, Pos1 + Len(s), Pos2 - Pos1 - Len(s)))
End Function

Public Sub RbsMask(MaskAcc As RBSTextNumEx, RBSAcc As String, MaskType As Integer)
    Dim TmpAcc As String
    Dim X As Integer
    Dim Y As Integer
    Dim Proceed As Boolean
   
   
    TmpAcc = "      "
    ' Mask type = 0 (UnMask)  = 1 (Mask)  = 2 (Unmask - wsAcc only)
    If Trim$(MaskAcc.Text) = "" Then
    MaskAcc.Text = "      "
    RBSAcc = MaskAcc.Text
    Exit Sub
    End If
   
    X = 1
    If MaskType <> 1 Then ' UnMask
    Proceed = False
    'Do While X <= 14
    Do While X <= 16
      If Mid(MaskAcc.Text, X, 1) = "-" Then Proceed = True
      X = X + 1
    Loop
    Else
    Proceed = True
    'Do While X <= 14
    Do While X <= 16
      If Mid(MaskAcc.Text, X, 1) = "-" Then Proceed = False
      X = X + 1
    Loop
    End If
   
    If Proceed = False Then
    If MaskType <> 1 Then RBSAcc = MaskAcc.Text
    Exit Sub
    End If
    RBSAcc = MaskAcc.Text
   
    X = 1
    Y = 1
    If MaskType <> 1 Then ' UnMask
    'Do While X <= 14
    Do While X <= 16
      If Mid(AccFmt, X, 1) <> "-" Then
      Mid(TmpAcc, Y, 1) = Mid(MaskAcc.Text, X, 1)
      Y = Y + 1
      End If
      X = X + 1
    Loop
    RBSAcc = TmpAcc
    Else     ' Mask
    'Do While X <= 14
    Do While X <= 16
     If Mid(AccFmt, X, 1) <> "-" Then
      Mid(TmpAcc, X, 1) = Mid(MaskAcc.Text, Y, 1)
      Y = Y + 1
      Else
      Mid(TmpAcc, X, 1) = "-"
      End If
      X = X + 1
    Loop
    End If
    If MaskType <> 2 Then
    MaskAcc.Text = TmpAcc
    End If
   
End Sub

Public Sub RBSMsg(ErrType As String, MsgID As String, Focus As Object, MsgType As Integer)
    Select Case MsgType
    Case 1  ' validation check
     MsgBox util.GetINI(ErrType, MsgID, MsgPath), _
      vbApplicationModal + vbCritical, "Validation Check"
    Case 2  ' record check
     MsgBox util.GetINI(ErrType, MsgID, MsgPath), _
      vbApplicationModal + vbOKOnly, "Record Check"
    Case 3  ' Prompt check
     MsgBox util.GetINI(ErrType, MsgID, MsgPath), _
      vbApplicationModal + vbOKOnly, "Prompt Check"
    Case 4  ' Database error check
     MsgBox util.GetINI(ErrType, MsgID, MsgPath), _
      vbApplicationModal + vbCritical, "DataBase error"
    Case 5  ' Database busy
      MsgBox util.GetINI(ErrType, MsgID, MsgPath), _
      vbApplicationModal + vbCritical, "Database busy"
    End Select
   
    If Focus.Enabled Then Focus.SetFocus
   
End Sub

iam getting error line i underlined.please any one suggest me.its very urgent... 



kalpana aparnathi replied to madhavi on 13-Jan-12 03:49 AM
you add a form and the lines:
 
con = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=;Initial Catalog=mydatabase;Data Source=myserver"
con.ConnectionString = "FILE NAME=c:\filedsn\mydSN.dsn"
con.open
 
The fileDSN contains:
 
[ODBC]
DRIVER=SQL Server
UID=Me
PWD=
DATABASE=Mydatabase
WSID=mycomputername
APP=myapp
SERVER=mycomputername
Anoop S replied to madhavi on 13-Jan-12 05:09 AM
The error you are receiving is a SQL Server one (SQLSTATE CODE: 28000). Usually this error is traced to a password incorrectly specified or the type of ConnectionString used, see this website for correct ConnectionString syntax;

http://www.connectionstrings.com/

double check your permissions to the database on SQL Server make sure the correct GRANT permissions are assigned to the user specified in your connectionstring.