M
Max
Hi all.
I have built an application that requires a module to protect itself;
it expires after 40 sessions of work. Some customer of mine told me
that they have a compilation error in that module, but in my PC I
can't see nothing.
Can someone help me?
Here's the module: I have substituted some string with "mio.....".
You can see and test the complete application downloading it from:
http://win.piccioli.com/cranesuite/cranesuite_11.exe
Note that the modules (Protect_All) is used in all the 3 application,
but my customers told me that the error occurs in only one each, and
not always the same.
Hope to be clear, sorry for my bad english
Thanks in advance, Massimiliano Piccioli
***************************************************************
Public Type GenrlType
InnerRec As String * 16
End Type
Public GenrlRec As GenrlType
Public Type SmallType
InnerRec As String * 2
End Type
Public SmallRec As SmallType
Declare Function GetSystemDirectoryA Lib "kernel32" _
(ByVal lpbuffer As String, ByVal nsize As Long) As Long
****************************************************************
Sub CheckUser()
Dim PTF As String
Dim GetYa As Long
Dim GetY1 As Long
Dim GetY2 As Long
Dim MyOut As String
Dim MyIn As String
Dim Tmp1 As String
Dim DDog As Variant
Dim ODog As Variant
Dim strPath As String, SysDir As String
strPath = Space(255)
SysDir = Left(strPath, GetSystemDirectoryA(strPath, Len(strPath)))
PTF = SysDir
PTF = PTF + "miofile"
PTF = UCase$(PTF)
DDog = Date
ODog = Time
Date = "miodate"
Time = "miotime"
On Error GoTo NewUser
Open PTF For Input Access Read As #11
Close #11
On Error GoTo 0
Open PTF For Binary Access Read As #11
Get #11, &H230, GenrlRec
Close #11
MyIn = GenrlRec.InnerRec
GetYa = Asc(Mid$(MyIn, 5, 1))
GetYa = GetYa * 256
GetYa = GetYa + Asc(Mid$(MyIn, 6, 1))
If GetYa > 32767 Then GetYa = GetYa - 65536
If GetYa = &HEFEF Then GoTo EndUser
If GetYa = &H37 Then GoTo Expired
GetYa = GetYa + 1
If GetYa < 0 Then GetYa = 65536 + GetYa
MyOut = Chr$(Int(GetYa / 256))
MyOut = MyOut + Chr$(GetYa Mod 256)
SmallRec.InnerRec = MyOut
Open PTF For Binary Access Write As #11
Put #11, &H234, SmallRec
Close #11
GoTo EndUser
NewUser:
On Error GoTo 0
MyOut = "mioout"
Open PTF For Binary Access Write As #11
Put #11, , MyOut
MyOut = Chr$(Val(Left$(DDog, 2)))
MyOut = MyOut + Chr$(Val(Mid$(DDog, 4, 2)))
GetY1 = Int(Val(Mid$(DDog, 7, 4)) / 256)
GetY2 = Val(Mid$(DDog, 7, 4)) Mod 256
MyOut = MyOut + Chr$(GetY1) + Chr$(GetY2)
MyOut = MyOut + Chr$(&H0) + Chr$(&H10)
MyOut = MyOut + Chr$(&H0) + Chr$(&H1)
MyOut = MyOut + Chr$(&H0) + Chr$(&H1)
MyOut = MyOut + Chr$(&H0) + Chr$(&H0) + Chr$(&H0) +
Chr$(&H0) + Chr$(&H0) + Chr$(&H0)
GenrlRec.InnerRec = MyOut
Put #11, &H230, GenrlRec
Close #11
Date = DDog
Time = ODog
MsgBox ("miomex")
GoTo MySubEnd
Expired:
Date = DDog
Time = ODog
MSG = ("miomex")
choice = MsgBox(MSG, vbYesNo)
If choice = vbYes Then
Call RelCo(code, pass)
MSGA = "miomexA"
MSGB = "miomexB"
MEX = MSGA & Chr(13) & code & Chr(13) & MSGB
PW = InputBox(MEX)
Else
ThisWorkbook.Close
End If
If PW = pass Or PW = "miopwd" Then
GetYa = &HEFEF
If GetYa < 0 Then GetYa = 65536 + GetYa
MyOut = Chr$(Int(GetYa / 256))
MyOut = MyOut + Chr$(GetYa Mod 256)
SmallRec.InnerRec = MyOut
DDog = Date
ODog = Time
Date = "miodate"
Time = "miotime"
Open PTF For Binary Access Write As #11
Put #11, &H234, SmallRec
Close #11
Date = DDog
Time = ODog
MsgBox ("miomex")
GoTo MySubEnd
Else
MsgBox ("miomex")
ThisWorkbook.Close
End If
EndUser:
Date = DDog
Time = ODog
MySubEnd:
End Sub
***************************************************************
Sub RelCo(code, pass)
Dim PC, SC, UC As String
Dim Lungh As Integer
Dim STR As String
Dim MyCode As String
On Error GoTo NoSTR
STR = Environ("computername")
Lungh = Len(STR)
PC = Left(STR, 1)
If Lungh < 2 Then
SC = "X"
Else
SC = Mid(STR, 2, 1)
End If
UC = Right(STR, 1)
MyCode = "CS10" & (Hex(Asc(PC) - 13)) & "S" & (Hex(Asc(SC) + 17)) &
"U" & (Hex(Asc(UC) + 13))
MyCode = UCase$(MyCode)
MyPass = (Asc(PC) + 57) & (Asc(SC) * 3) & (Asc(UC) * 2)
GoTo MyEnd
On Error GoTo 0
NoSTR:
MyCode = "miocode"
MyPass = "miopwd"
MyEnd:
code = MyCode
pass = MyPass
End Sub
I have built an application that requires a module to protect itself;
it expires after 40 sessions of work. Some customer of mine told me
that they have a compilation error in that module, but in my PC I
can't see nothing.
Can someone help me?
Here's the module: I have substituted some string with "mio.....".
You can see and test the complete application downloading it from:
http://win.piccioli.com/cranesuite/cranesuite_11.exe
Note that the modules (Protect_All) is used in all the 3 application,
but my customers told me that the error occurs in only one each, and
not always the same.
Hope to be clear, sorry for my bad english
Thanks in advance, Massimiliano Piccioli
***************************************************************
Public Type GenrlType
InnerRec As String * 16
End Type
Public GenrlRec As GenrlType
Public Type SmallType
InnerRec As String * 2
End Type
Public SmallRec As SmallType
Declare Function GetSystemDirectoryA Lib "kernel32" _
(ByVal lpbuffer As String, ByVal nsize As Long) As Long
****************************************************************
Sub CheckUser()
Dim PTF As String
Dim GetYa As Long
Dim GetY1 As Long
Dim GetY2 As Long
Dim MyOut As String
Dim MyIn As String
Dim Tmp1 As String
Dim DDog As Variant
Dim ODog As Variant
Dim strPath As String, SysDir As String
strPath = Space(255)
SysDir = Left(strPath, GetSystemDirectoryA(strPath, Len(strPath)))
PTF = SysDir
PTF = PTF + "miofile"
PTF = UCase$(PTF)
DDog = Date
ODog = Time
Date = "miodate"
Time = "miotime"
On Error GoTo NewUser
Open PTF For Input Access Read As #11
Close #11
On Error GoTo 0
Open PTF For Binary Access Read As #11
Get #11, &H230, GenrlRec
Close #11
MyIn = GenrlRec.InnerRec
GetYa = Asc(Mid$(MyIn, 5, 1))
GetYa = GetYa * 256
GetYa = GetYa + Asc(Mid$(MyIn, 6, 1))
If GetYa > 32767 Then GetYa = GetYa - 65536
If GetYa = &HEFEF Then GoTo EndUser
If GetYa = &H37 Then GoTo Expired
GetYa = GetYa + 1
If GetYa < 0 Then GetYa = 65536 + GetYa
MyOut = Chr$(Int(GetYa / 256))
MyOut = MyOut + Chr$(GetYa Mod 256)
SmallRec.InnerRec = MyOut
Open PTF For Binary Access Write As #11
Put #11, &H234, SmallRec
Close #11
GoTo EndUser
NewUser:
On Error GoTo 0
MyOut = "mioout"
Open PTF For Binary Access Write As #11
Put #11, , MyOut
MyOut = Chr$(Val(Left$(DDog, 2)))
MyOut = MyOut + Chr$(Val(Mid$(DDog, 4, 2)))
GetY1 = Int(Val(Mid$(DDog, 7, 4)) / 256)
GetY2 = Val(Mid$(DDog, 7, 4)) Mod 256
MyOut = MyOut + Chr$(GetY1) + Chr$(GetY2)
MyOut = MyOut + Chr$(&H0) + Chr$(&H10)
MyOut = MyOut + Chr$(&H0) + Chr$(&H1)
MyOut = MyOut + Chr$(&H0) + Chr$(&H1)
MyOut = MyOut + Chr$(&H0) + Chr$(&H0) + Chr$(&H0) +
Chr$(&H0) + Chr$(&H0) + Chr$(&H0)
GenrlRec.InnerRec = MyOut
Put #11, &H230, GenrlRec
Close #11
Date = DDog
Time = ODog
MsgBox ("miomex")
GoTo MySubEnd
Expired:
Date = DDog
Time = ODog
MSG = ("miomex")
choice = MsgBox(MSG, vbYesNo)
If choice = vbYes Then
Call RelCo(code, pass)
MSGA = "miomexA"
MSGB = "miomexB"
MEX = MSGA & Chr(13) & code & Chr(13) & MSGB
PW = InputBox(MEX)
Else
ThisWorkbook.Close
End If
If PW = pass Or PW = "miopwd" Then
GetYa = &HEFEF
If GetYa < 0 Then GetYa = 65536 + GetYa
MyOut = Chr$(Int(GetYa / 256))
MyOut = MyOut + Chr$(GetYa Mod 256)
SmallRec.InnerRec = MyOut
DDog = Date
ODog = Time
Date = "miodate"
Time = "miotime"
Open PTF For Binary Access Write As #11
Put #11, &H234, SmallRec
Close #11
Date = DDog
Time = ODog
MsgBox ("miomex")
GoTo MySubEnd
Else
MsgBox ("miomex")
ThisWorkbook.Close
End If
EndUser:
Date = DDog
Time = ODog
MySubEnd:
End Sub
***************************************************************
Sub RelCo(code, pass)
Dim PC, SC, UC As String
Dim Lungh As Integer
Dim STR As String
Dim MyCode As String
On Error GoTo NoSTR
STR = Environ("computername")
Lungh = Len(STR)
PC = Left(STR, 1)
If Lungh < 2 Then
SC = "X"
Else
SC = Mid(STR, 2, 1)
End If
UC = Right(STR, 1)
MyCode = "CS10" & (Hex(Asc(PC) - 13)) & "S" & (Hex(Asc(SC) + 17)) &
"U" & (Hex(Asc(UC) + 13))
MyCode = UCase$(MyCode)
MyPass = (Asc(PC) + 57) & (Asc(SC) * 3) & (Asc(UC) * 2)
GoTo MyEnd
On Error GoTo 0
NoSTR:
MyCode = "miocode"
MyPass = "miopwd"
MyEnd:
code = MyCode
pass = MyPass
End Sub