vbAccelerator - Contents of code file: forTest5.frm
VERSION 5.00
Begin VB.Form forTest
Caption = "Test GUID Generator"
ClientHeight = 4260
ClientLeft = 1170
ClientTop = 2820
ClientWidth = 4275
Icon = "forTest5.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4260
ScaleWidth = 4275
Begin VB.TextBox txtGUIDCount
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 2400
TabIndex = 2
Text = "1"
Top = 60
Width = 555
End
Begin VB.TextBox txtGUIDs
BeginProperty Font
Name = "Lucida Console"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3795
Left = 0
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Top = 420
Width = 4215
End
Begin VB.CommandButton cmdGenerate
Caption = "&Generate"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3060
TabIndex = 0
Top = 0
Width = 1155
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Number of GUID's to Generate:"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 60
TabIndex = 3
Top = 120
Width = 2250
End
End
Attribute VB_Name = "forTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdGenerate_Click()
Dim objGUIDGenerator As CSGUID5.GUIDGenerator
Dim lngCount As Long
Dim sGUID As String
Set objGUIDGenerator = New CSGUID5.GUIDGenerator
txtGUIDs = ""
For lngCount = 1 To txtGUIDCount
sGUID = objGUIDGenerator.CreateGUID("")
txtGUIDs = txtGUIDs & sGUID & vbCrLf & GUIDToVBCode(sGUID) & vbCrLf & vbCrLf
Next
Set objGUIDGenerator = Nothing
End Sub
Private Function GUIDToVBCode(ByVal sGUID As String) As String
Dim sOut As String
Dim i As Long
sGUID = Replace(sGUID, "{", "")
sGUID = Replace(sGUID, "}", "")
sGUID = Replace(sGUID, "-", "")
sOut = "With tG" & vbCrLf
sOut = sOut & " .Data1 = &H" & Left$(sGUID, 4) & "&" & vbCrLf & _
" .Data2 = &H" & Mid$(sGUID, 5, 4) & "&" & vbCrLf & _
" .Data3 = &H" & Mid$(sGUID, 9, 4) & "&" & vbCrLf
For i = 0 To 7
sOut = sOut & " .Data(i) = &H" & Mid$(sGUID, 17 + i, 2) & vbCrLf
Next i
sOut = sOut & "End With"
GUIDToVBCode = sOut
End Function
' author: Steve. VB5 equivalent of VB6 replace function
Private Function Replace(ByRef sThis As String, ByVal sToReplace As String,
ByVal sReplaceWith As String) As String
Dim iPos As Long
Dim iNextPos As Long
Dim lLen As Long
lLen = Len(sToReplace)
iPos = 1
iNextPos = InStr(sThis, sToReplace)
Do While Not (iNextPos = 0)
Replace = Replace & Mid$(sThis, iPos, iNextPos - iPos) & sReplaceWith
iPos = iNextPos + lLen
iNextPos = InStr(iPos, sThis, sToReplace)
Loop
If iPos < Len(sThis) Then
Replace = Replace & Mid$(sThis, iPos)
End If
End Function
Private Sub Form_Resize()
On Error Resume Next
txtGUIDs.Move txtGUIDs.Left, txtGUIDs.Top, Me.ScaleWidth - txtGUIDs.Left *
2, Me.ScaleHeight - txtGUIDs.Top - 2 * Screen.TwipsPerPixelY
End Sub
|
|