杀戮间Cache文件夹整理-CSDN博客

本文链接：https://blog.csdn.net/chenbw1/article/details/6451677

你从某人的服务器下载了一个插件或地图，然后你会发现你在游戏里是找不到它的，其实它并没有消失，而是以缓存的形式保存下来了，所以你再次进入服务器时就不用下载。但是如果你想让他成为自己所用的东西，接下来的步骤就很有用。。。。。

你还在用幽灵的老方法整理吗？！
是否因为Cache文件夹已经有了几百个文件而无从下手？！

哥为此而打造的神器完美的解决了这个问题！！
（好吧，界面不是很完美。。为了精简软件没办法了。。）

软件界面：

使用方法：
双击选择KillingFloor文件夹后点击开始整理即可

下载地址1（XP下应该能直接运行，win7不确定）：
http://u.115.com/file/dn15iqyo

下载地址2（自带了动态链接库，如果上面那个打不开再试这个）：
http://u.115.com/file/clszt6bh

PS:
1、感谢helahaohao友情测试并提出宝贵建议！
2、使用中出现任何问题请到此贴提出

code:

Dim path, inipath, cachepath, nfpath, ofpath, unknowname As String
Private Sub Command1_Click()
    On Error Resume Next
    
    '判断路径是否正确
    If Dir(path & "/KF_revLoader.exe") = "" And Dir(path & "/RUN_KF.exe") = "" Then
        MsgBox ("请选择正确的路径（需双击选择路径）！")
        Exit Sub
    End If
        
        
    'path = "D:/killingfloor/KillingFloor"   '测试时使用
    cachepath = path & "/Cache/"
    inipath = path & "/Cache/cache.ini"
    
    '判断Cache.ini是否存在
    If Dir(inipath) = "" Then
        MsgBox ("请确认Cache.ini文件存在，不存在则不需要整理！")
        Exit Sub
    End If
    
    '提示可能出现的假死
    MsgBox ("如果临时文件比较大，处理时间会较长，程序看似卡死其实是在处理，请稍后即可...")
    
    Open inipath For Input As #1
        Dim temp, oname, nname, ftype As String
        Dim sl, pt As Integer
        Line Input #1, temp
        
        '判断是否需要整理
        If (LOF(1) < 30) Then
            MsgBox ("文件不需要整理！")
            End
        End If
        
        
        '使光标达到第一条记录
        While (Len(temp) < 10)
            Line Input #1, temp
        Wend
        
        Do While (True)
            sl = Len(temp) - 35
            oname = Left(temp, 34) & ".uxx"
            nname = Right(temp, sl)
            pt = InStr(1, nname, ".", vbTextCompare)
            If pt <> 0 Then  '判断为有后缀
                ftype = Mid(nname, pt + 1)
                '根据各种后缀判断新路径
                ofpath = cachepath & oname
                If (ftype = "u") Then
                    nfpath = path & "/system/" & nname
                ElseIf (ftype = "rom") Then
                    nfpath = path & "/Maps/" & nname
                ElseIf (ftype = "utx") Then
                    nfpath = path & "/Textures/" & nname
                ElseIf (ftype = "uax") Then
                    nfpath = path & "/Sounds/" & nname
                ElseIf (ftype = "ukx") Then
                    nfpath = path & "/Animations/" & nname
                ElseIf (ftype = "usx") Then
                    nfpath = path & "/StaticMeshes/" & nname
                ElseIf (ftype = "ogg") Or (ftype = "mp3") Then
                    nfpath = path & "/Music/" & nname
                Else    '未知后缀更名后不处理
                    nfpath = path & "/Cache/" & nname
                End If
                '复制文件到新路径
                FileCopy ofpath, nfpath
                '删除文件
                Kill ofpath
            End If
            Text1.Text = Text1.Text & "旧文件名" & oname & "新文件名" & nname & "后缀" & ftype & Chr(13) & Chr(10)
            If (EOF(1)) Then Exit Do
            Line Input #1, temp
        Loop
        
        'Text1.text = Text1.text + path  '测试app.path带不带最后的斜杠
        
    Close #1
        
    Open inipath For Output As #1
        Print #1, "[Cache]" & Chr(13) & Chr(10)
    Close #1
    
    '提示整理完成
    MsgBox ("整理完成！")
    Text1.Text = Text1.Text & "整理完成！"
    
    Exit Sub
    
        
End Sub

Private Sub Dir1_Change()
    Text1.Text = Dir1.path & Chr(13) & Chr(10)
    path = Dir1.path
End Sub
Private Sub Drive1_Change()
    Dir1.path = Drive1.Drive
End Sub
Private Sub Form_Load()
    Drive1.Drive = "C:"
    Dir1.path = "c:/"
End Sub