Tweet
Since a lot of people have asked me for this and I don't use it anymore - here it is.
THe code in the other DLL's can be found on this message board, a LOT of this is cut/paste except for teh creativity of writing to the file/format etc...
It can be detected by any program that watches file I/O, deleting the file would give a user another 30 days.
THe code in the other DLL's can be found on this message board, a LOT of this is cut/paste except for teh creativity of writing to the file/format etc...
It can be detected by any program that watches file I/O, deleting the file would give a user another 30 days.
Code:
#Compile Dll
#Register None
#Include "WIN32API.INC"
#Resource "CCSREG.PBR"
%CCSURL1 = %WM_USER + 2015
Global osinfo As OSVERSIONINFO
Declare Function CheckIfEvaluationExpired(AppName As String,ccsFileSpec As String,EvalDaysAllowed As Long)As Long
Declare CallBack Function EvalProc() As Long
Declare Function EvalMessage(hWnd As Long,AppName As String,St As String,URL As String) As Long
'Duplicated from CCS.DLL
Declare Function GetFileDateandTime(ccsFileSpec As String,ft As SYSTEMTIME) As Long
Declare Function SetFileDateandTime(ccsFileSpec As String,ft As SYSTEMTIME) As Long
Declare Function GetPCTimeandDate() As String
Declare Function GetInstallDate(ft As SYSTEMTIME) As String
Declare Function IsPastExpireDate(InstallDate As String,EvalDays As Long) As Long
Declare Function GetRegistrationInfo(wRegUser As String,wRegCompany As String) As Long
Declare Function InitUrlCtrl Lib "CCS.DLL"() As Long
Declare Function Exist Lib "CCS.DLL"(ByVal filespec As String)As Long
Declare Function CCSGetSystemDir Lib "CCS.DLL"() As String
Declare Function GetSetting Lib "CCS.DLL"(lpKey As Long ,ByVal MainKey As String, ByVal SubKey As String, _
ByVal wDefault As String) As String
Declare Function GetINIData Lib "CCS.DLL"( IniFile As String,GroupName As String, ParName As String, wDefault As String)As String
Declare Function WriteIniData Lib "CCS.DLL"(IniFile As String,GroupName As String, ParName As String,wValue As String) As Long
Declare Function AppPath Lib "CCS.DLL"() As String
Declare Function FormatTime Lib "CCSDATE.DLL"(st As SYSTEMTIME,TimeFormat As String,DateFormat As String)As String
Declare Function uString Lib "CCSDATE.DLL"(ByVal x As String) As String
Declare Function StrToVbDate Lib "CCSDATE.DLL"(ByVal dt As String) As Double
Union QuadFILETIME
dwLowDateTime As Dword
dwHighDateTime As Dword
qdTime As Quad
End Union
%CCS = 2006
%LOCK = 2004
%IMAGE = %WM_USER + 1024
%HK = %HKEY_LOCAL_MACHINE
%OneDay = 864000000000&&
'----------------------------------------------------------
Global aDlg As Long
Global pDlg As Long
Global g_hIcon As Long
Global g_hInst As Long
Global g_Result As Long
Global g_Copyrite As String
Global Password As String
Global CCS As String
Global URL As String
Global ghLibTest As Long
Global gReason As Long
Global gReserved As Long
Global gNumOfTimes As Dword
Global gNumOfCheck As Dword
'------------------------------------------------------------------------------------------
Function LibMain(ByVal hInstance As Long, _
ByVal Reason As Long, _
ByVal Reserved As Long) Export As Long
ghLibTest = hInstance
gReason = Reason
gReserved = Reserved
CCS = "Computer Creations Software"
URL = "http://www.tngbbs.com/ccs"
g_Copyrite = "Copyright © 2000"
g_hInst = hInstance
Incr gNumOfTimes
Select Case Reason
Case %DLL_PROCESS_ATTACH
gNumOfCheck = 1234
LibMain = 1 'success!
Exit Function
Case %DLL_PROCESS_DETACH
LibMain = 1 'success!
Exit Function
Case %DLL_THREAD_ATTACH
LibMain = 1 'success!
Exit Function
Case %DLL_THREAD_DETACH
LibMain = 1 'success!
Exit Function
End Select
End Function
'------------------------------------------------------------------------------------------
Function CheckIfEvaluationExpired(AppName As String,ccsFileSpec As String,EvalDaysAllowed As Long) Export As Long
Local hFile As Long
Local Himem As String 'Himem.sys
Local Bs As String 'Backspace "\"
Local ft As SYSTEMTIME 'Use this one for himem, st for time
Local it As SYSTEMTIME 'Use this one for install date on folder installed to
Local cDate As String 'Current Date
Local sDate As String 'Stored Date
Local x As Long
Local lResult As Long
Himem = CCSGetSystemDir & "\" & "Himem.sys"
'MsgBox "Created date: " & GetInstallDate
'ccsFileSpec is any file you create, ie MSCCSDLL.DLL - looks official but is a text file when done
'It always goes in the Windows\system32 folder (CCSGetSystemDir)
If IsFalse Exist(ByVal ccsFileSpec) Then 'Create a file
hFile = FreeFile
Open ccsFileSpec For Output Lock Write As #hFile
'Pad the file with BS to look like an official file
Print #hFile, ";The following lines are required for compatibility with other programs."
Print #hFile,";Do not remove them (" + ccsFileSpec + " needs to be >1024 bytes)."
For x = 3 To 21
Print #hFile,";" + String$(71,"x") + Chr$(x)
Next
Close #hFile
'New install? Write file, insert install date return false
'Write the Install Date to the file now
lResult = WriteIniData(ccsFileSpec,AppName, "Install Date",GetInstallDate(it))
Else
'Look for a previous installation date, sDate not used, "it" will now be used
sDate = GetINIData( ccsFileSpec,AppName, "Install Date", GetInstallDate(it))
If IsFalse Len(sDate) Then
lResult = WriteIniData(ccsFileSpec,AppName, "Install Date",GetInstallDate(it))
End If
If IsTrue IsPastExpireDate(sDate,EvalDaysAllowed) Then
Function = %TRUE
End If
End If
'Now make our file set to the same date as Himem.sys (A system file)
'This prevents someone from doing DIR /OD to find last modified file.
lResult = GetFileDateandTime(Himem,ft)
lResult = SetFileDateandTime(ccsFileSpec,ft)
End Function
'------------------------------------------------------------------------------------------
'GetInstallDate retrieves the date of folder creation for the applications
'Default install folder.
'------------------------------------------------------------------------------
Function GetInstallDate(ft As SYSTEMTIME) As String
Local fd As WIN32_FIND_DATA
Local hFile As Long
Local sTmp As String
sTmp = AppPath
sTmp = Left$(sTmp,Len(sTmp)-1) 'Remove the backslash
fd.dwFileAttributes = fd.dwFileAttributes And %FILE_ATTRIBUTE_DIRECTORY
hFile = FindFirstFile(ByVal StrPtr(sTmp),fd)
If IsFalse hFile Then Exit Function
' -- Convert the file time from UTC to local time
FileTimeToLocalFileTime fd.ftLastWriteTime, fd.ftLastWriteTime
' -- Convert the file time into a compatible system time
FileTimeToSystemTime fd.ftLastWriteTime, ft
Function = FormatTime(ft,"hh':'mm':'ss tt","MM-dd-yyyy")
End Function
'------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------
'EvalDays is how many days they are allowed To evaluate the software
'InstallDate will be In this format:
' "MMM dd',' yyyy" "hh:mm tt"
Function IsPastExpireDate(InstallDate As String,EvalDays As Long)Export As Long
Local ctdate As Double
Local indate As Double
Local st As SYSTEMTIME
Local ct As SYSTEMTIME
'Convert InstallDate to double
indate = StrToVbDate(InstallDate)
'Get Current Time
GetlocalTime ct
'Convert CurrentDate to double
SystemTimeToVariantTime ct, ctdate 'Current Time in variant format
'Compare the two dates and see
'If it's greater than the allowed evaluation time
If (ctdate - indate) > EvalDays Then Function = %TRUE
End Function
'------------------------------------------------------------------------------------------
Function SetFileDateandTime(ccsFileSpec As String,ft As SYSTEMTIME)Export As Long
Local hFile As Long
Local Result As Long
Local ccsFileTime As FILETIME
Local fLocTime As FILETIME
hFile = CreateFile(ccsFileSpec + Chr$(0), ByVal %GENERIC_READ Or %GENERIC_WRITE, _
ByVal 0, ByVal %NULL, ByVal %OPEN_ALWAYS, _
ByVal %FILE_ATTRIBUTE_NORMAL, ByVal %NULL)
' convert system date/time to file structure.
SystemTimeToFileTime ft, fLocTime
' convert local file time to UTC file time
' setfiletime expects a time that is relative to utc time.
LocalFileTimeToFileTime fLocTime, ccsFileTime
' set the file time
Result = SetFileTime(ByVal hFile, ByVal %NULL, ByVal %NULL, ccsFileTime)
CloseHandle hFile
Function = Result
End Function
'------------------------------------------------------------------------------------------
Function GetFileDateandTime(ccsFileSpec As String,ft As SYSTEMTIME)Export As Long
Dim fd As WIN32_FIND_DATA
Local hFile As Long
hFile = FindFirstFile(ByVal StrPtr(ccsFileSpec),fd)
If IsFalse hFile Then Exit Function
' -- Convert the file time from UTC to local time
FileTimeToLocalFileTime fd.ftLastWriteTime, fd.ftLastWriteTime
' -- Convert the file time into a compatible system time
FileTimeToSystemTime fd.ftLastWriteTime, ft
Function = %TRUE
End Function
'------------------------------------------------------------------------------------------
Function EvalMessage(hWnd As Long,AppName As String,St As String,URL As String)Export As Long
InitUrlCtrl
Dialog New hWnd,AppName,,, 250,65,%WS_CAPTION Or %WS_SYSMENU To aDlg
Control Add Image, aDlg, %IMAGE,"#2006",5,5,18,18
Control Add Label, aDlg, 1, St, 35,1, 200,45
Control Add Label, aDlg, 1, g_Copyrite,35,35, 100, 12
'URL = https://www.regnow.com/softsell/nph-softsell.cgi?item=4316-3&referrer=1"
Control Add "CCSURL", aDlg, %CCSURL1, "Register at Regnow.com;" & URL ,35,50, 120, 12, %WS_VISIBLE Or %WS_CHILD
Control Add Button, aDlg, %IDOK, "&OK",180,45,45,16, %BS_DEFAULT
Dialog Send aDlg, %WM_SETICON, %ICON_BIG, LoadIcon(g_hInst, ByVal %LOCK)
Control Set Focus aDlg, %IDOK
Dialog Show Modal aDlg Call EvalProc
Function = 1
End Function
'-----------------------------------------------------------------------------------------
CallBack Function EvalProc() As Long
Local wMsg As Long
Local wParam As Long
Local lParam As Long
wMsg = CbMsg
lParam = CbLParam
wparam = CbWParam
Select Case wMsg
Case %WM_INITDIALOG
Control Set Focus CbHndl,%IDOK
Case %WM_TIMER
Case %WM_DESTROY
Case %WM_COMMAND
Select Case LoWrd(wParam)
Case %IDOK
Dialog End aDlg, 1
Exit Function
End Select
End Select
End Function
'-----------------------------------------------------------------------------------------
Function GetPCTimeandDate() Export As String
Local st As SYSTEMTIME
Local tDay As Asciiz * 64
Local tTime As Asciiz * 64
GetLocalTime st
' -- Create a date string using the local settings
GetDateFormat %LOCALE_USER_DEFAULT, %NULL, st, "MMM dd',' yyyy", tDay, 64
' -- Create a time string using the local settings
GetTimeFormat %LOCALE_USER_DEFAULT, %TIME_NOSECONDS, st, "hh:mm tt", tTime, 64
Function = tDay + " " + tTime
End Function
'------------------------------------------------------------------------------------------
Function GetRegistrationInfo(wRegUser As String,wRegCompany As String) Export As Long
Local RegKey As String
osinfo.dwOsVersionInfoSize = SizeOf(osinfo)
GetVersionEx osinfo
If osinfo.dwPlatformId = %VER_PLATFORM_WIN32_NT Then
RegKey = "Software\Microsoft\Windows NT\CurrentVersion"
Else
RegKey = "Software\Microsoft\Windows\CurrentVersion"
End If
wRegUser = GetSetting(%HK ,ByVal RegKey, "RegisteredOwner","")
wRegCompany = GetSetting(%HK ,ByVal RegKey,"RegisteredOrganization","")
End Function
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------
Comment