dcsimg


DevX Home    Today's Headlines   Articles Archive   Tip Bank   Forums   

Results 1 to 2 of 2

Thread: Rare Code That i need help with! PLEASE

  1. #1
    Join Date
    Aug 2004
    Posts
    43,023

    Rare Code That i need help with! PLEASE

    [Originally posted by Jeff]

    ok i neeed some help

    someone could help me find a way to get full rights to this im not understanding this at all

    Ifya want the full code ill send it to ya email me at
    whothatbe2@hotmail.com


    thanks i just wanna be able to use this fully
    not limited






    Option Explicit
    Option Compare Text
    Public KartaAgent
    Const MyDefaultDir = "C:\Windows\MSagent\chars\"
    Public MyDir As String
    Public CurrentAgentDir, WhichAgent, BubbleVisible As String
    Public myOldNumber As Integer
    Public myNewNumber As Integer
    Public gPathApp
    Public myPath As String
    Public AgentShown, AgentVisible As Boolean
    Public Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
    '˙ -das Begin add
    Public gErr As Long
    Public gErrStr As String
    Public Const KARTA_ERROR_INTRO = "KartaNarrator has detected an non-recoverable error. " _
    ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ & "Please call Karta at 1-800-72KARTA and report the error message provided below." & vbCrLf & vbCrLf
    Public Const CHARACTER_ALREADY_LOADED = -2147213301
    Public Const ANIMATION_NOT_SUPPORTED = -2147213309
    Public Const AGENT_UNABLE_TO_START = -2147212030
    Public Const NO_ACTIVE_PRESENTATION_SLIDE = -2147188160
    '˙ -das End add


    Public Declare Function RegQueryValueEx& Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long)
    Public Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwReserved As Long, ByVal samDesired As Long, phkResult As Long) As Long
    Public Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
    Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

    Public Const HKEY_CLASSES_ROOT = &H80000000
    Public Const HKEY_CURRENT_USER = &H80000001
    Public Const HKEY_LOCAL_MACHINE = &H80000002
    Public Const HKEY_CURRENT_CONFIG = &H80000005
    Public Const HKEY_USERS = &H80000003
    Public Const ERROR_SUCCESS = 0&
    Public Const SYNCHRONIZE = &H100000
    Public Const STANDARD_RIGHTS_READ = &H20000
    Public Const STANDARD_RIGHTS_WRITE = &H20000
    Public Const STANDARD_RIGHTS_EXECUTE = &H20000
    Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
    Public Const STANDARD_RIGHTS_ALL = &H1F0000
    Public Const KEY_QUERY_VALUE = &H1
    Public Const KEY_SET_VALUE = &H2
    Public Const KEY_CREATE_SUB_KEY = &H4
    Public Const KEY_ENUMERATE_SUB_KEYS = &H8
    Public Const KEY_NOTIFY = &H10
    Public Const KEY_CREATE_LINK = &H20
    Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
    ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ KEY_QUERY_VALUE Or _
    ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ KEY_ENUMERATE_SUB_KEYS Or _
    ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ KEY_NOTIFY) And _
    ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ ˙ (Not SYNCHRONIZE))
    Public Const REG_DWORD = 4
    Public Const REG_BINARY = 3
    Public Const REG_SZ = 1
    Public Const Complete = 0

    Type TEXTMETRIC
    ˙ ˙ tmHeight As Integer
    ˙ ˙ tmAscent As Integer
    ˙ ˙ tmDescent As Integer
    ˙ ˙ tmInternalLeading As Integer
    ˙ ˙ tmExternalLeading As Integer
    ˙ ˙ tmAveCharWidth As Integer
    ˙ ˙ tmMaxCharWidth As Integer
    ˙ ˙ tmWeight As Integer
    ˙ ˙ tmItalic As String * 1
    ˙ ˙ tmUnderlined As String * 1
    ˙ ˙ tmStruckOut As String * 1
    ˙ ˙ tmFirstChar As String * 1
    ˙ ˙ tmLastChar As String * 1
    ˙ ˙ tmDefaultChar As String * 1
    ˙ ˙ tmBreakChar As String * 1
    ˙ ˙ tmPitchAndFamily As String * 1
    ˙ ˙ tmCharSet As String * 1
    ˙ ˙ tmOverhang As Integer
    ˙ ˙ tmDigitizedAspectX As Integer
    ˙ ˙ tmDigitizedAspectY As Integer
    End Type

    '** Win32 API DECLARATIONS **
    Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
    Declare Function GetDesktopWindow Lib "user32" () As Long
    Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long
    Declare Function GetSystemMetrics& Lib "user32" (ByVal nIndex As Long)

    Public Const SM_CXSCREEN = 0
    Public Const SM_CYSCREEN = 1
    Public Const SM_CXVSCROLL = 2
    Public Const SM_CYHSCROLL = 3
    Public Const SM_CYCAPTION = 4
    Public Const SM_CXBORDER = 5
    Public Const SM_CYBORDER = 6
    Public Const SM_CXDLGFRAME = 7
    Public Const SM_CYDLGFRAME = 8
    Public Const SM_CYVTHUMB = 9
    Public Const SM_CXHTHUMB = 10
    Public Const SM_CXICON = 11
    Public Const SM_CYICON = 12
    Public Const SM_CXCURSOR = 13
    Public Const SM_CYCURSOR = 14
    Public Const SM_CYMENU = 15
    Public Const SM_CXFULLSCREEN = 16
    Public Const SM_CYFULLSCREEN = 17
    Public Const SM_CYKANJIWINDOW = 18
    Public Const SM_MOUSEPRESENT = 19
    Public Const SM_CYVSCROLL = 20
    Public Const SM_CXHSCROLL = 21
    Public Const SM_DEBUG = 22
    Public Const SM_SWAPBUTTON = 23
    Public Const SM_RESERVED1 = 24
    Public Const SM_RESERVED2 = 25
    Public Const SM_RESERVED3 = 26
    Public Const SM_RESERVED4 = 27
    Public Const SM_CXMIN = 28
    Public Const SM_CYMIN = 29
    Public Const SM_CXSIZE = 30
    Public Const SM_CYSIZE = 31
    Public Const SM_CXFRAME = 32
    Public Const SM_CYFRAME = 33
    Public Const SM_CXMINTRACK = 34
    Public Const SM_CYMINTRACK = 35
    Public Const SM_CXDOUBLECLK = 36
    Public Const SM_CYDOUBLECLK = 37
    Public Const SM_CXICONSPACING = 38
    Public Const SM_CYICONSPACING = 39
    Public Const SM_MENUDROPALIGNMENT = 40
    Public Const SM_PENWINDOWS = 41
    Public Const SM_DBCSENABLED = 42
    Public Const SM_CMOUSEBUTTONS = 43
    Public Const SM_CXFIXEDFRAME = SM_CXDLGFRAME
    Public Const SM_CYFIXEDFRAME = SM_CYDLGFRAME
    Public Const SM_CXSIZEFRAME = SM_CXFRAME
    Public Const SM_CYSIZEFRAME = SM_CYFRAME
    Public Const SM_SECURE = 44
    Public Const SM_CXEDGE = 45
    Public Const SM_CYEDGE = 46
    Public Const SM_CXMINSPACING = 47
    Public Const SM_CYMINSPACING = 48
    Public Const SM_CXSMICON = 49
    Public Const SM_CYSMICON = 50
    Public Const SM_CYSMCAPTION = 51
    Public Const SM_CXSMSIZE = 52
    Public Const SM_CYSMSIZE = 53
    Public Const SM_CXMENUSIZE = 54
    Public Const SM_CYMENUSIZE = 55
    Public Const SM_ARRANGE = 56
    Public Const SM_CXMINIMIZED = 57
    Public Const SM_CYMINIMIZED = 58
    Public Const SM_CXMAXTRACK = 59
    Public Const SM_CYMAXTRACK = 60
    Public Const SM_CXMAXIMIZED = 61
    Public Const SM_CYMAXIMIZED = 62
    Public Const SM_NETWORK = 63
    Public Const SM_CLEANBOOT = 67
    Public Const SM_CXDRAG = 68
    Public Const SM_CYDRAG = 69
    Public Const SM_SHOWSOUNDS = 70
    Public Const SM_CXMENUCHECK = 71
    Public Const SM_CYMENUCHECK = 72
    Public Const SM_SLOWMACHINE = 73
    Public Const SM_MIDEASTENABLED = 74
    Public Const SM_CMETRICS = 75


    Global Const MM_TEXT = 1
    Public Function gbl_GetFontRes$()
    ˙  Dim hdc, hwnd, PrevMapMode As Long
    ˙  Dim tm As TEXTMETRIC
    ˙ ˙  gbl_GetFontRes$ = "VGA"
    ˙ ˙  hwnd = GetDesktopWindow()
    ˙ ˙  hdc = GetWindowDC(hwnd)
    ˙ ˙  If hdc Then
    ˙ ˙ ˙  PrevMapMode = SetMapMode(hdc, MM_TEXT)
    ˙ ˙ ˙  GetTextMetrics hdc, tm
    ˙ ˙ ˙  PrevMapMode = SetMapMode(hdc, PrevMapMode)
    ˙ ˙ ˙  ReleaseDC hwnd, hdc
    ˙ ˙ ˙ ˙ If tm.tmHeight > 16 Then
    ˙ ˙ ˙ ˙ ˙ ˙ gbl_GetFontRes$ = "8514"
    ˙ ˙ ˙ ˙ Else
    ˙ ˙ ˙ ˙ ˙ ˙ gbl_GetFontRes$ = "9"
    ˙ ˙ ˙ ˙ End If
    ˙ ˙ End If
    ˙  End Function
    Public Function GetScreenResolution()
    ˙ ˙ Dim myX, myY As Long
    ˙ ˙ myX = GetSystemMetrics&(SM_CXSCREEN)
    ˙ ˙ myY = GetSystemMetrics&(SM_CYSCREEN)
    ˙ ˙ Dim temp As String
    ˙ ˙ temp = myX & "," & myY
    ˙ ˙ GetScreenResolution = temp
    End Function
    Public Function CopyMasterTemplate()
    ˙ ˙ Dim lngKeyHandle As Long
    ˙ ˙ Dim lngResult As Long
    ˙ ˙ Dim lngCurIdx As Long
    ˙ ˙ Dim strValue As String
    ˙ ˙ Dim lngValueLen As Long
    ˙ ˙ Dim lngData As Long
    ˙ ˙ Dim lngDataLen As Long
    ˙ ˙ Dim strResult As String
    ˙ ˙ lngResult = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Office\8.0\Common\FileNew\LocalTemplates", 0&, KEY_READ, lngKeyHandle)
    ˙ ˙ If lngResult <> ERROR_SUCCESS Then
    ˙ ˙ ˙ ˙ Exit Function
    ˙ ˙ End If
    ˙ ˙
    ˙ ˙ lngValueLen = 2000
    ˙ ˙ strValue = String(lngValueLen, 0)
    ˙ ˙ lngDataLen = 2000
    ˙ ˙ Dim MyDir As String * 2000
    ˙ ˙ Dim dwType As Long
    ˙ ˙ lngResult = RegQueryValueEx&(lngKeyHandle, &quot;&quot;, 0, dwType, ByVal MyDir, lngDataLen)

    ˙ ˙ Call RegCloseKey(lngKeyHandle)
    ˙ ˙ Dim temp As String
    ˙ ˙ Dim retVal
    ˙ ˙ If lngDataLen >= 1 Then
    ˙ ˙ ˙ ˙ temp = Left(MyDir, lngDataLen - 1)
    ˙ ˙ End If
    ˙ ˙ CopyMasterTemplate = temp
    End Function

    Public Function AmIRegistered()
    ˙ ˙ Dim lngKeyHandle As Long
    ˙ ˙ Dim lngResult As Long
    ˙ ˙ Dim lngCurIdx As Long
    ˙ ˙ Dim strValue As String
    ˙ ˙ Dim lngValueLen As Long
    ˙ ˙ Dim lngData As Long
    ˙ ˙ Dim lngDataLen As Long
    ˙ ˙ Dim strResult As String
    ˙ ˙ lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, &quot;Software\Karta Technologies, Inc.\KartaNarrator\3.00.000&quot;, 0&, KEY_READ, lngKeyHandle)
    ˙ ˙ 'MsgBox lngResult
    ˙ ˙ AmIRegistered = True
    ˙ ˙ If lngResult <> ERROR_SUCCESS Then
    ˙ ˙ ˙ ˙ 'AmIRegistered = False
    ˙ ˙ ˙ ˙ AmIRegistered = True
    ˙ ˙ ˙ ˙ Exit Function
    ˙ ˙ End If
    ˙ ˙
    ˙ ˙ lngValueLen = 2000
    ˙ ˙ strValue = String(lngValueLen, 0)
    ˙ ˙ lngDataLen = 2000
    ˙ ˙ Dim MyDir As String * 2000
    ˙ ˙ Dim dwType As Long
    ˙ ˙ lngResult = RegQueryValueEx&(lngKeyHandle, &quot;Serial&quot;, 0, dwType, ByVal MyDir, lngDataLen)
    ˙ ˙ 'MsgBox lngKeyHandle
    ˙ ˙
    ˙ ˙ Call RegCloseKey(lngKeyHandle)
    ˙ ˙ Dim temp As String
    ˙ ˙ Dim retVal
    ˙ ˙ If lngDataLen >= 1 Then
    ˙ ˙ ˙ ˙ temp = Left(MyDir, lngDataLen - 1)
    ˙ ˙ End If
    ˙ ˙ ˙ ˙ Dim myTempLength
    ˙ ˙ ˙ ˙ myTempLength = Len(temp)
    ˙ ˙ If myTempLength < 1000 Then
    ˙ ˙ ˙ ˙ AmIRegistered = True
    ˙ ˙ End If
    End Function


    Public Sub QuickSort(vntArray As Variant, Optional intLBound As Integer, Optional intUBound As Integer)
    ˙ ˙ Dim vntMid As Variant
    ˙ ˙ If (VarType(vntArray) And vbArray) = 0 Then Exit Sub
    ˙ ˙ If intLBound = 0 And intUBound = 0 Then
    ˙ ˙ ˙ ˙ intLBound = LBound(vntArray)
    ˙ ˙ ˙ ˙ intUBound = UBound(vntArray)
    ˙ ˙ End If
    ˙ ˙ If intLBound > intUBound Then Exit Sub
    ˙ ˙ If (intUBound - intLBound) = 1 Then
    ˙ ˙ ˙ ˙ If StrComp(vntArray(intLBound), vntArray(intUBound)) > 0 Then
    ˙ ˙ ˙ ˙ ˙ ˙ Swap vntArray(intLBound), vntArray(intUBound)
    ˙ ˙ ˙ ˙ End If
    ˙ ˙ ˙ ˙ Exit Sub
    ˙ ˙ End If
    ˙ ˙ Dim I As Integer, j As Integer

    ˙ ˙ vntMid = vntArray(intUBound)

    ˙ ˙ Do
    ˙ ˙ ˙ ˙ I = intLBound
    ˙ ˙ ˙ ˙ j = intUBound
    ˙ ˙ ˙ ˙ Do While (I < j) And StrComp(vntArray(I), vntMid) <= 0
    ˙ ˙ ˙ ˙ ˙ ˙ I = I + 1
    ˙ ˙ ˙ ˙ Loop
    ˙ ˙ ˙ ˙ Do While (j > I) And StrComp(vntArray(j), vntMid) >= 0
    ˙ ˙ ˙ ˙ ˙ ˙ j = j - 1
    ˙ ˙ ˙ ˙ Loop
    ˙ ˙ ˙ ˙ If I < j Then Swap vntArray(I), vntArray(j)
    ˙ ˙ Loop While I < j
    ˙ ˙ Swap vntArray(I), vntArray(intUBound)
    ˙ ˙ If (I - intLBound) < (intUBound - I) Then
    ˙ ˙ ˙ ˙ QuickSort vntArray, intLBound, I - 1
    ˙ ˙ ˙ ˙ QuickSort vntArray, I + 1, intUBound
    ˙ ˙ Else

    ˙ ˙ ˙ ˙ QuickSort vntArray, I + 1, intUBound
    ˙ ˙ ˙ ˙ QuickSort vntArray, intLBound, I - 1
    ˙ ˙ End If
    End Sub


    Private Sub Swap(ByRef vntItem1, ByRef vntItem2 As Variant)
    ˙ ˙ Dim vntTemp As Variant
    ˙ ˙ vntTemp = vntItem1
    ˙ ˙ vntItem1 = vntItem2
    ˙ ˙ vntItem2 = vntTemp
    End Sub

  2. #2
    Join Date
    Aug 2004
    Posts
    43,023

    Re:Rare Code That i need help with! PLEASE

    [Originally posted by payal]

    how can I link sound files to vb 6 code.
    I want to a sound to play when the user clicks on the wrong command button in my form.the sound should play when the is a user˙ commits an error.
    please mail me and let me know.
    payal

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
HTML5 Development Center
 
 
FAQ
Latest Articles
Java
.NET
XML
Database
Enterprise
Questions? Contact us.
C++
Web Development
Wireless
Latest Tips
Open Source


   Development Centers

   -- Android Development Center
   -- Cloud Development Project Center
   -- HTML5 Development Center
   -- Windows Mobile Development Center