home *** CD-ROM | disk | FTP | other *** search
VERSION 5.00 Begin VB.Form AboutF BorderStyle = 1 'Fixed Single Caption = "About Source Code Organizer V.1" ClientHeight = 3690 ClientLeft = 45 ClientTop = 330 ClientWidth = 3630 HelpContextID = 1340 Icon = "AboutF.frx":0000 KeyPreview = -1 'True LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 3690 ScaleWidth = 3630 StartUpPosition = 2 'CenterScreen Begin VB.Frame Frame3 Caption = "Contact Information" Height = 1215 Left = 120 TabIndex = 4 Top = 1080 Width = 3375 Begin VB.Label Label4 AutoSize = -1 'True Caption = "extremedexter_z2001@yahoo.com" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = -1 'True Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 195 Left = 600 MousePointer = 99 'Custom TabIndex = 7 ToolTipText = "E-mail Developer" Top = 720 Width = 2460 End Begin VB.Label Label2 AutoSize = -1 'True Caption = "Mail:" Height = 195 Index = 0 Left = 240 TabIndex = 6 Top = 720 Width = 330 End Begin VB.Label Label1 AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Written by: Dexter Zafra" Height = 195 Left = 240 TabIndex = 5 Top = 360 Width = 1695 End End Begin VB.Frame Frame4 Caption = "Website" Height = 735 Left = 120 TabIndex = 2 Top = 2400 Width = 3375 Begin VB.Label Label3 AutoSize = -1 'True Caption = "http://clik.to/ret" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = -1 'True Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 240 Left = 960 MousePointer = 99 'Custom TabIndex = 3 ToolTipText = "Visit Developer's Website" Top = 240 Width = 1515 End End Begin VB.CommandButton Command1 Caption = "&OK" Height = 375 Left = 240 TabIndex = 1 Top = 3240 Width = 1455 End Begin VB.CommandButton Command2 Caption = "&System Info ..." Height = 375 Left = 1920 TabIndex = 0 Top = 3240 Width = 1455 End Begin VB.Label Label24 Caption = "Organizer" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 600 TabIndex = 10 Top = 600 Width = 1335 End Begin VB.Label Label8 AutoSize = -1 'True Caption = "Source Code" BeginProperty Font Name = "Arial" Size = 20.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 480 Left = 480 TabIndex = 9 Top = 120 Width = 2550 End Begin VB.Label Label9 AutoSize = -1 'True Caption = "Version 1" Height = 195 Left = 2040 TabIndex = 8 Top = 720 Width = 660 End Attribute VB_Name = "AboutF" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit ' Reg Key Security Options... Const READ_CONTROL = &H20000 Const KEY_QUERY_VALUE = &H1 Const KEY_SET_VALUE = &H2 Const KEY_CREATE_SUB_KEY = &H4 Const KEY_ENUMERATE_SUB_KEYS = &H8 Const KEY_NOTIFY = &H10 Const KEY_CREATE_LINK = &H20 Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _ KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _ KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL ' Reg Key ROOT Types... Const HKEY_LOCAL_MACHINE = &H80000002 Const ERROR_SUCCESS = 0 Const REG_SZ = 1 ' Unicode nul terminated string Const REG_DWORD = 4 ' 32-bit number Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location" Const gREGVALSYSINFOLOC = "MSINFO" Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO" Const gREGVALSYSINFO = "PATH" Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long Private Sub Command1_Click() Unload Me End Sub Private Sub Command2_Click() Call StartSysInfo End Sub Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 27 Then Unload Me End Sub Private Sub Label3_Click() On Error Resume Next Dim xRet As Long xRet = ShellExecute(0, vbNullString, "http://clik.to/ret", vbNullString, App.Path, 1) End Sub Private Sub Label4_Click() On Error Resume Next Call email("extremedexter_z2001@yahoo.com") End Sub Public Sub StartSysInfo() On Error GoTo SysInfoErr Dim rc As Long Dim SysInfoPath As String If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then SysInfoPath = SysInfoPath & "\MSINFO32.EXE" Else GoTo SysInfoErr End If Else GoTo SysInfoErr End If Call Shell(SysInfoPath, vbNormalFocus) Exit Sub SysInfoErr: MsgBox "La informaci n del sistema no est disponible en este momento.", vbOKOnly End Sub Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean Dim i As Long ' Loop Counter Dim rc As Long ' Return Code Dim hKey As Long ' Handle To An Open Registry Key Dim hDepth As Long ' Dim KeyValType As Long ' Data Type Of A Registry Key Dim tmpVal As String ' Tempory Storage For A Registry Key Value Dim KeyValSize As Long ' Size Of Registry Key Variable '------------------------------------------------------------ ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...} '------------------------------------------------------------ rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Error... tmpVal = String$(1024, 0) ' Allocate Variable Space KeyValSize = 1024 ' Mark Variable Size '------------------------------------------------------------ ' Retrieve Registry Key Value... '------------------------------------------------------------ rc = RegQueryValueEx(hKey, SubKeyRef, 0, _ KeyValType, tmpVal, KeyValSize) ' Get/Create Key Value If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String... tmpVal = left(tmpVal, KeyValSize - 1) ' Null Found, Extract From String Else ' WinNT Does NOT Null Terminate String... tmpVal = left(tmpVal, KeyValSize) ' Null Not Found, Extract String Only End If '------------------------------------------------------------ ' Determine Key Value Type For Conversion... '------------------------------------------------------------ Select Case KeyValType ' Search Data Types... Case REG_SZ ' String Registry Key Data Type KeyVal = tmpVal ' Copy String Value Case REG_DWORD ' Double Word Registry Key Data Type For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value Char. By Char. Next KeyVal = Format$("&h" + KeyVal) ' Convert Double Word To String End Select GetKeyValue = True ' Return Success rc = RegCloseKey(hKey) ' Close Registry Key Exit Function ' Exit GetKeyError: ' Cleanup After An Error Has Occured... KeyVal = "" ' Set Return Val To Empty String GetKeyValue = False ' Return Failure rc = RegCloseKey(hKey) ' Close Registry Key End Function 
(.txt)