savepdg.bas

来自「本VB源程序实现对超星图书pdg文件页面的提取和加密破解。方法是运行ssread」· BAS 代码 · 共 97 行

Attribute VB_Name = "SavePDG"
Sub Main()

    
    Dim s100 As String * 100
    Dim fl As Long
    
    
    On Error Resume Next 'GoTo err1
    'On Error GoTo err1

    Open "C:\Program Files\WinGate\cache\cache.idx" For Binary As #1
    'Open "cache.idx" For Binary As #1
    
    'fl = FileLen("C:\Program Files\WinGate\cache\cache.idx")
    fl = LOF(1)
    
    stmp = ""
    
    tmp = Dir(App.Path & "\pdg", vbDirectory)
    If tmp <> "" Then
        tmp = Dir(App.Path & "\pdg\")
    
        Do While tmp <> ""
                    
            Kill App.Path & "\pdg\" & tmp
            tmp = Dir
        Loop
    Else
        MkDir App.Path & "\pdg"
    End If
    
    
    tmp = ""
    
    Do While Not EOF(1)
        
        Get #1, , s100
        stmp = stmp & s100
        
        
rdo1:
        pdgloc = InStrB(1, stmp, ".pdg" & Chr(8), 0)
        If pdgloc > 1 Then
            
            If MidB(stmp, pdgloc - 2, 2) = "/" Then    'is "/.pdg"
                stmp = MidB(stmp, pdgloc + 4)
                GoTo rdo1
                
            Else                                    'is "######.pdg"
                If LenB(stmp) >= pdgloc + 24 Then   'info completed
                    fnmo = MidB(stmp, pdgloc - 12, 12) & ".pdg"
                    fnms = MidB(stmp, pdgloc + 10, 16) & ".wgc"
                    
                    If tmp = "" Then tmp = Dir("C:\Program Files\WinGate\cache\" & fnms)
                    If tmp <> "" Then
                        FileCopy "C:\Program Files\WinGate\cache\" & fnms, App.Path & "\pdg\" & fnmo
                    Else
                        DoEvents
                    
                    End If
                    
                    
                    'If tmp <> "" Then FileCopy fnms, fnmo
                    
                    'Kill fnms
                    stmp = MidB(stmp, pdgloc + 36)
                    GoTo rdo1
                    
                Else                               'info incompleted
                    'do nothing
                    
                End If
            
            End If
            
        ElseIf pdgloc = 1 Then
            stmp = MidB(stmp, 6)
            
        End If

    Loop

    
    Close #1
    
    Exit Sub

err1:

    Close #1
    
    MsgBox "Error!"


End Sub