Dim massiv(10) As String
Dim x as String
'
'
'
massiv(0) = "я"
massiv(1) = "a"
massiv(2) = "б"
massiv(3) = "в"
'и так далее....
x = massiv(Int(Rnd * 10))
Attribute VB_Name = "mdlGenerate"
Private Const HEXletter = "ABCDEFabcdef"
Public Function GenerateID() As String
GenerateID = FormatGenerator(6, 5, " - ")
End Function
Public Function GenerateLetter() As String
'Randomize
Dim temp As Integer
Do Until (temp > 65) And (temp <> 91) And (temp <> 92) And (temp <> 93) And (temp <> 94) And (temp <> 95) And (temp <> 96) And (temp < 122)
temp = Int(Rnd() * 1000)
Loop
GenerateLetter = Chr(temp)
End Function
Public Function Generate_A_Z_1() As String
'Randomize
Dim temp As Integer
Do Until (temp > 65) And (temp < 91)
temp = Int(Rnd() * 1000)
Loop
Generate_A_Z_1 = Chr(temp)
End Function
Public Function Generate_a_z_2() As String
'Randomize
Dim temp As Integer
Do Until (temp > 96) And (temp < 122)
temp = Int(Rnd() * 1000)
Loop
Generate_a_z_2 = Chr(temp)
End Function
Public Function GenerateHEXletter() As String
'Randomize
Dim temp As String
On Error Resume Next
temp = "!"
Do Until InStr(1, HEXletter, temp) > 0
temp = Chr(Rnd() * 255)
Loop
GenerateHEXletter = temp
End Function
Public Function GenerateNumber() As Byte
'Randomize
GenerateNumber = Int(Rnd() * 10)
End Function
Public Function TextToNumber(Text As String) As String
Dim i As Long
Dim letter As String
For i = 1 To Len(Text)
letter = Mid(Text, i, 1)
TextToNumber = TextToNumber & Asc(letter)
Next
End Function
Public Function FormatGenerator(SectorsInCode As Long, CharsInSector As Long, Separator As String, Optional Numbers As Boolean = True, Optional BigChars As Boolean = True, Optional SmallChars As Boolean = True, Optional HEXchars As Boolean = False) As String
If Numbers = False And BigChars = False And SmallChars = False And HEXchars = False Then Exit Function
Randomize
If SectorsInCode > 100 Then Exit Function
Dim temp As Integer
Dim temp2 As String
Dim code As String
Dim CIS(1 To 100) As String
Dim i As Long, j As Long
For j = 1 To SectorsInCode
For i = 1 To CharsInSector
go1:
Do
temp = CInt(Rnd() * 10)
Loop Until (temp = 1) Or (temp = 2) Or (temp = 3) Or (temp = 4)
If temp = 1 And BigChars = True Then
temp2 = temp2 & Generate_A_Z_1
ElseIf temp = 4 And SmallChars = True Then
temp2 = temp2 & Generate_a_z_2
ElseIf temp = 2 And Numbers = True Then
temp2 = temp2 & GenerateNumber
ElseIf temp = 3 And HEXchars = True Then ' Then '
temp2 = temp2 & GenerateHEXletter
Else
GoTo go1
End If
temp = 0
Next
CIS(j) = temp2
temp2 = ""
If code <> "" Then
code = code & Separator & CIS(j)
Else
code = CIS(j)
End If
Next
FormatGenerator = code
End Function
Public Function NumberAndText(Number As Long) As String
If Right(Number, 1) = Number Then
If Right$(Number, 1) = 0 Or Right$(Number, 1) = 5 Or Right$(Number, 1) = 6 Or Right$(Number, 1) = 7 Or Right$(Number, 1) = 8 Or Right$(Number, 1) = 9 Then NumberAndText = Number & " частей"
If Right$(Number, 1) = 1 Then NumberAndText = Number & " часть"
If Right$(Number, 1) = 2 Or Right$(Number, 1) = 3 Or Right$(Number, 1) = 4 Then NumberAndText = Number & " части"
Else
NumberAndText = Number & " частей"
End If
End Function
Public Function GenerateCLSID() As String
Randomize
Dim i As Byte
Dim Gen As String
Dim temp As Integer
'Gen = "{"
For i = 1 To 8
Do Until (temp = 1) Or (temp = 2) Or (temp = 3) Or (temp = 4) ' Or (temp = 5) Or (temp = 6)
temp = CByte(Rnd() * 10)
Loop
If temp = 1 Then
Gen = Gen & GenerateHEXletter
Else
Gen = Gen & GenerateNumber
End If
temp = 0
Next
'XXXXXXXX
i = 0
Gen = Gen & "-"
For i = 1 To 4
Do Until (temp = 1) Or (temp = 2) Or (temp = 3) Or (temp = 4) 'Or (temp = 5) Or (temp = 6)
temp = CByte(Rnd() * 10)
Loop
If temp = 1 Then
Gen = Gen & GenerateHEXletter
Else
Gen = Gen & GenerateNumber
End If
temp = 0
Next
'XXXXXXXX-XXXX
i = 0
Gen = Gen & "-"
For i = 1 To 4
Do Until (temp = 1) Or (temp = 2) Or (temp = 3) Or (temp = 4) 'Or (temp = 5) Or (temp = 6)
temp = CByte(Rnd() * 10)
Loop
If temp = 1 Then
Gen = Gen & GenerateHEXletter
Else
Gen = Gen & GenerateNumber
End If
temp = 0
Next
'XXXXXXXX-XXXX-XXXX
i = 0
Gen = Gen & "-"
For i = 1 To 4
Do Until (temp = 1) Or (temp = 2) Or (temp = 3) Or (temp = 4) 'Or (temp = 5) Or (temp = 6)
temp = CByte(Rnd() * 10)
Loop
If temp = 1 Then
Gen = Gen & GenerateHEXletter
Else
Gen = Gen & GenerateNumber
End If
temp = 0
Next
'XXXXXXXX-XXXX-XXXX-XXXX
i = 0
Gen = Gen & "-"
For i = 1 To 12
Do Until (temp = 1) Or (temp = 2) Or (temp = 3) Or (temp = 4) 'Or (temp = 5) Or (temp = 6)
temp = CByte(Rnd() * 10)
Loop
If temp = 1 Then
Gen = Gen & GenerateHEXletter
Else
Gen = Gen & GenerateNumber
End If
temp = 0
Next
GenerateCLSID = Gen '& "}"
End Function
Private Declare Function CoCreateGuid Lib "ole32" (id As Any) As Long
Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Declare Function CoCreateGuid Lib "OLE32.DLL" (pGUID As GUID) As Long
Declare Function StringFromGUID2 Lib "OLE32.DLL" (pGUID As GUID, ByVal sGUID As String, ByVal MaxLength
As Long) As Long
...
Function CreateGUID2() As String
Dim G As GUID, S As String, I As Long
Call CoCreateGuid(G)
S = Space$(128)
I = StringFromGUID2(G, S, Len(S))
If I = 0 Then Exit Function
CreateGUID2 = Left$(StrConv(S, vbFromUnicode), I - 1)
End Function
const alphabet as string="abcdefghijklmnopqrstuvwyz"
function randchar as string
randchar=mid(alphabet,round(rnd*len(alphabet)),1)
end function
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 44