杀戮间Cache文件夹整理

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

你还在用幽灵的老方法整理吗？！
是否因为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 StringPrivate 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 SubPrivate Sub Dir1_Change() Text1.Text = Dir1.path & Chr(13) & Chr(10) path = Dir1.pathEnd SubPrivate Sub Drive1_Change() Dir1.path = Drive1.DriveEnd SubPrivate Sub Form_Load() Drive1.Drive = "C:" Dir1.path = "c:/"End Sub