[請益] 請問

[linmic (sOMeThiNGwRoNg)]

該如何在任一程式中加上檢查使用時限?

就如同各Beta版的程式會檢查試用期限一樣

謝謝

--
如果某一個人無聲的在妳心裡留下印子，妳會時時想起他，時時說到他ꄊ那是愛情的第一步，酸酸的，酸到有點苦，但妳會努力的找出那甜蜜的部份

--
※ 發信站: 批踢踢實業坊(ptt.cc) 
◆ From: 220.139.133.198

> -------------------------------------------------------------------------- <

作者: fumizuki (小獅) 看板: Visual_Basic
標題: Re: [請益] 請問
時間: Sat Apr 16 08:27:01 2005

※ 引述《linmic (sOMeThiNGwRoNg)》之銘言：
: 該如何在任一程式中加上檢查使用時限?
: 就如同各Beta版的程式會檢查試用期限一樣
: 謝謝
假如限制只能使用30天的話...
1) 建立一個檔案，儲存安裝日期(或天數)，每次執行程式時檢查是否超過30天。
2) 把安裝日期(或天數)存在registry中。
3) 把安裝日期(或天數)存在執行檔的末端 (Chr(0) 之後)。

並且要有編碼，讓人看不懂，難以破解。

--
人若無星爺，跟條鹹魚有何分別？

--
※ 發信站: 批踢踢實業坊(ptt.cc) 
◆ From: 210.58.156.43

> -------------------------------------------------------------------------- <

作者: linmic (sOMeThiNGwRoNg) 看板: Visual_Basic
標題: Re: [請益] 請問
時間: Sat Apr 16 12:14:33 2005

※ 引述《fumizuki (小獅)》之銘言：
: ※ 引述《linmic (sOMeThiNGwRoNg)》之銘言：
: : 該如何在任一程式中加上檢查使用時限?
: : 就如同各Beta版的程式會檢查試用期限一樣
: : 謝謝
: 假如限制只能使用30天的話...
: 1) 建立一個檔案，儲存安裝日期(或天數)，每次執行程式時檢查是否超過30天。
: 2) 把安裝日期(或天數)存在registry中。
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^<--想請問這個步驟的做法^^"
: 3) 把安裝日期(或天數)存在執行檔的末端 (Chr(0) 之後)。
: 並且要有編碼，讓人看不懂，難以破解。

--
如果某一個人無聲的在妳心裡留下印子，妳會時時想起他，時時說到他ꄊ那是愛情的第一步，酸酸的，酸到有點苦，但妳會努力的找出那甜蜜的部份

--
※ 發信站: 批踢踢實業坊(ptt.cc) 
◆ From: 220.139.133.198

> -------------------------------------------------------------------------- <

作者: seansylin (sylin) 看板: Visual_Basic
標題: Re: [請益] 請問
時間: Sat Apr 16 13:07:52 2005

※ 引述《linmic (sOMeThiNGwRoNg)》之銘言：
: ※ 引述《fumizuki (小獅)》之銘言：
: : 假如限制只能使用30天的話...
: : 1) 建立一個檔案，儲存安裝日期(或天數)，每次執行程式時檢查是否超過30天。
: : 2) 把安裝日期(或天數)存在registry中。
:      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^<--想請問這個步驟的做法^^"
: : 3) 把安裝日期(或天數)存在執行檔的末端 (Chr(0) 之後)。
: : 並且要有編碼，讓人看不懂，難以破解。


SaveSetting subdir,section,key,value '儲存登入檔
GetSetting subdir,section,key,default '讀取登錄檔
DeleteSetting subdir,section,key,value '這個會遞回刪除子資料

大概就是這樣

---
話說beta版不是試用版(alpha是內測試版，beta是外測試版)，demo才是

還有，其實這樣做真的很容易破解XD

--
※ 發信站: 批踢踢實業坊(ptt.cc) 
◆ From: 218.166.217.51

> -------------------------------------------------------------------------- <

作者: advicer (剪刀手愛德華) 看板: Visual_Basic
標題: Re: [請益] 請問
時間: Sat Apr 16 14:09:17 2005

※ 引述《seansylin (sylin)》之銘言：
: ※ 引述《linmic (sOMeThiNGwRoNg)》之銘言：
: :      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^<--想請問這個步驟的做法^^"
: SaveSetting subdir,section,key,value '儲存登入檔
: GetSetting subdir,section,key,default '讀取登錄檔
: DeleteSetting subdir,section,key,value '這個會遞回刪除子資料
: 大概就是這樣
: ---
: 話說beta版不是試用版(alpha是內測試版，beta是外測試版)，demo才是
: 還有，其實這樣做真的很容易破解XD

現在很多測試版都是所謂的alpha 或是beta版本,
自然很多人都這麼認為,
藏好一點就可以了...:)
不需要用特殊的字串,用普通的字串去存.記得要編碼.
這樣就比較不好找.

--
※ 發信站: 批踢踢實業坊(ptt.cc) 
◆ From: 140.123.20.101

> -------------------------------------------------------------------------- <

作者: fumizuki (小獅) 看板: Visual_Basic
標題: Re: [請益] 請問
時間: Sat Apr 16 14:13:31 2005

※ 引述《advicer (剪刀手愛德華)》之銘言：
: ※ 引述《seansylin (sylin)》之銘言：
: : SaveSetting subdir,section,key,value '儲存登入檔
: : GetSetting subdir,section,key,default '讀取登錄檔
: : DeleteSetting subdir,section,key,value '這個會遞回刪除子資料
: : 大概就是這樣
: : ---
: : 話說beta版不是試用版(alpha是內測試版，beta是外測試版)，demo才是
: : 還有，其實這樣做真的很容易破解XD
: 現在很多測試版都是所謂的alpha 或是beta版本,
: 自然很多人都這麼認為,
: 藏好一點就可以了...:)
: 不需要用特殊的字串,用普通的字串去存.記得要編碼.
: 這樣就比較不好找.
假設30天限制

預設值設為30

無法讀取資料，或天數超過範圍，都視為30天，就是不能用的意思

這樣就算被找到了，他也沒那麼容易破解:Q

也可以塞一點有的沒的東西進去 反正讓人猜不透就對了XD

--
人若無星爺，跟條鹹魚有何分別？

--
※ 發信站: 批踢踢實業坊(ptt.cc) 
◆ From: 210.58.156.43

> -------------------------------------------------------------------------- <

作者: fumizuki (小獅) 看板: Visual_Basic
標題: Re: [請益] 請問
時間: Sun Apr 17 13:30:03 2005

' 請自行從 API 檢視員中找出下列函式：
' RegCreateKey、RegOpenKey、RegQueryValueEx、ExpandEnvironmentStrings
' RegSetValueEx、lStrLenB
' 以及常數：
' HKEY_CURRENT_USER、REG_BINARY、REG_DWORD、REG_SZ、REG_DWORD_BIG_ENDIAN
' REG_MULTI_SZ、REG_EXPAND_SZ
'
' 並且在適當的地方給 data1 一個初始值...(Now / 24)
' ex. 安裝程式
'
' P.S. 沒有測試過，不確定會不會有錯誤=_=

Option Explicit

Sub Main()
On Error Goto ErrProc
'程式進入點

    Dim lngNum As Long, hKey As Long, SoftPath As String, ret1, ret2, x, y
    SoftPath = "SOFTWARE\公司名稱\軟體名稱"
    ret1 = GetKeyValue(HKEY_CURRENT_USER, SoftPath, "data1", 0, 0) * 24
    ret2 = GetKeyValue(HKEY_CURRENT_USER, SoftPath, "data2", 0, 0) * 24
    x = Now - ret2  '現在時間與上次使用時間的差距(單位:天)
                    '避免偷改系統時間的偷雞行為
    y = ret2 - ret1 '總共使用天數
    If x <= 0 Or x >= 30 Or y <= 0 Or y >= 30 Then
       Msgbox "30天試用期限已到，請購買正式版。", vbInformation
       End
    End If

    '記錄這次使用的時間
    If RegCreateKey(HKEY_CURRENT_USER, SoftPath, hKey) <> 0 Then Err.Raise 5
    If Not SetKeyValue(hKey, "data2", Now / 24) Then Err.Raise 5

    '檢查完成，載入表單
    Load Form1
    Form1.Show
    Exit Sub

errProc:
    Msgbox "程式發生錯誤", vbInformation

End Sub

Public Function GetKeyValue(ByVal RootPath As Long, ByVal KeyPath As String, _
       ByVal KeyName As String, KeyType, Optional DefaultValue)
On Error GoTo errProc

    Dim hKey As Long, ret As Long, lenData As Long, typeData As Long

    If RegOpenKey(RootPath, KeyPath, hKey) <> 0 Then GoSub NotFoundProc

    If RegQueryValueEx(hKey, KeyName, 0, typeData, ByVal vbNullString, _
       lenData) <> 0 Then GoSub NotFoundProc: GoTo EndProc

    If typeData = REG_SZ Or typeData = REG_EXPAND_SZ Or _
       typeData = REG_MULTI_SZ Then         'Data type is String

       Dim s As String
       s = String(lenData, Chr(0))
       RegQueryValueEx hKey, KeyName, 0, typeData, ByVal s, lenData
       If typeData = REG_SZ Then            'Normal string

          If s <> "" Then s = Left(s, InStr(s, Chr(0)) - 1)
          GetKeyValue = s: KeyType = vbString

       ElseIf typeData = REG_EXPAND_SZ Then 'String which is have %WINPATH%

          Dim s2 As String
          s2 = String(Len(s) + 256, Chr(0))
          ExpandEnvironmentStrings s, s2, Len(s2)
          GetKeyValue = Left(s2, InStr(s2, Chr(0)) - 1): KeyType = vbString

       ElseIf typeData = REG_MULTI_SZ Then  'String which is a array

          GetKeyValue = Split(Left(s, Len(s) - 2), Chr(0)): KeyType = vbArray

       End If

    ElseIf typeData = REG_DWORD Or typeData = REG_DWORD_BIG_ENDIAN Then
                                            'Data type is dword

       Dim l As Long: RegQueryValueEx hKey, KeyName, 0, typeData, l, lenData
       GetKeyValue = l: KeyType = vbLong

    ElseIf typeData = REG_BINARY Then       'Data type is binary

       If lenData = 0 Then

          GetKeyValue = "": KeyType = vbNull

       Else

          ReDim bArr(lenData - 1) As Byte
          RegQueryValueEx hKey, KeyName, 0, typeData, bArr(0), lenData
          GetKeyValue = StrConv(bArr, vbUnicode): KeyType = vbByte

       End If

    End If

EndProc:
    RegCloseKey hKey: Exit Function

NotFoundProc:
    GetKeyValue = DefaultValue: GoTo EndProc

errProc:
    Debug.Print Err.Description: GetKeyValue = Empty: Resume EndProc

End Function

Public Function SetKeyValue(ByVal hKey As Long, ByVal KeyName As String, _
       ByVal KeyValue) As Boolean
On Error GoTo errProc

    Dim ret As Long, KeyLength As Long, i As Single, j As Single, kv As Single
    kv = VarType(KeyValue)

    If kv = vbDate Or kv = vbString Or kv = vbDecimal Or kv = vbSingle Or _

       kv = vbDouble Then
       KeyLength = lStrLenB(KeyValue) + 1
       If KeyValue = "" Then KeyLength = 0
       ret = RegSetValueEx(hKey, KeyName, 0, REG_SZ, ByVal CStr(KeyValue), _
             KeyLength)
       If ret = 0 Then SetKeyValue = True

    ElseIf kv = vbInteger Or kv = vbLong Or kv = vbBoolean Then

       Dim tv As Long: tv = KeyValue
       ret = RegSetValueEx(hKey, KeyName, 0, REG_DWORD, tv, LenB(tv))
       If ret = 0 Then SetKeyValue = True

    ElseIf kv = vbByte Or kv = vbByte + vbArray Or kv = vbArray Then

       If kv = vbArray Then
          i = lStrLenB(KeyValue) - 1
       Else
          i = UBound(KeyValue)
       End If

       ReDim bValue(i) As Byte
       For j = 0 To i
           If kv = vbArray Then
              bValue(j) = AscB(MidB(StrConv(KeyValue, vbFromUnicode), j, 1))
           Else
              bValue(j) = KeyValue(j)
           End If
       Next
       ret = RegSetValueEx(hKey, KeyName, 0, REG_BINARY, bValue(0), _
                           UBound(bValue) + 1)
       If ret = 0 Then SetKeyValue = True

    Else

       SetKeyValue = False

    End If
    Exit Function

errProc:
    Debug.Print Err.Description: SetKeyValue = False

End Function

--
VB 程式設計   倉木麻衣       PTT 星爺板     行列輸入法
======================================================
Visual_Basic  MaiKuraki      Stephen        Array

--
※ 發信站: 批踢踢實業坊(ptt.cc) 
◆ From: 210.58.156.43
推 linmic:你真是太盡責了...