|10| الحصول على أسماء المحطات للشبكات

**أبو هادي** · مايو 13, 2004

السلام عليكم

مثال للحصول على أسماء المحطات/الطرفيات لشبكة Windows 2000 Server .

يحتاج لملف net.exe وعادة يتواجد على C:\WINDOWS\system32

ويتم حفظه ومساره في جدول Path التابع للمثال .

تحياتي .

OnLineMachines.rar

zakwan · مايو 17, 2004

اولا اخي ابو هادي

كنت منشغل منذ فتره عن هذا المنتدى الغالي وعند دخولي اليوم ورأيت انك اصبحت مشرفا لم اتفاجئ مع انني كنت اعتقد نيل الاشراف من زمان لما تحمله من معلومات .

ولو انها متأخره ولكن الف مبروك وتقبل صادق التهاني .

بالنسبه لموضوعك اشكرك على هذا الموضوع لأنني بحاجه اليه وسأقوم حاليا بتجربته واوافيك بما حصل معي وشكراً.

**محمد طاهر عرفه** · مايو 25, 2004

بدا لي من اسم الملف أنه خاص ب ويندوز 98 كعميل

جربت تجربة مبدأية ، و لم أحصل علي النتيجة ، و توقف الاكسيس

سأجرب ثانية بعد بعض التظبيط فى الجهاز

سؤال ، هل استنتاج أنه معد فقط ل 98 سليم ، أم يمكن التجربة مع اكس بي ؟

**أبو هادي** · مايو 26, 2004

السلام عليكم

أخي محمد .. أضف السطر If TextLine = "" Then Exit Do كما هو موضح بالكود التالي وجرب مرة أخرى بأي إصدار للوندوز .

  Do While Not EOF(1)
    Line Input #1, TextLine
    If TextLine = "" Then Exit Do
    Pos = InStr(1, TextLine, "\\")
    If Pos > 0 Then
      With rst
        .AddNew
          !ServerName = RTrim(Mid(TextLine, 3, 20))
          !Remarks = RTrim(Mid(TextLine, 24, 50))
        .Update
      End With
    End If
  Loop

تحياتي .

تم تعديل مايو 26, 2004 بواسطه أبو هادي

**محمد طاهر عرفه** · مايو 27, 2004

كان يوجد خطأ لدي فى التطبيق

و هو الاشارة الي ملف net.exe الخاص ب 98 فى جدول ال path بينما أنا فى اكس بي

و بتعديل القيمة الي نفس المسار الي الملف الخاص بالاكس بي

ظهرت النتيجة سليمة فى ملف النص المسمي MACLIST

و لكن الكود يعمل بنجاح و يعطي أسماء الاجهزة ووصفها فى ملف النص

و لا تظهر بالنموذج

استدراك :

و باعادة الكود الي اصله قبل التعديل الاخير ، يعطي النتيجة سليمة (y)

ملاحظة بسيطة

أنه عند التشغيل للنموذج لاول مرة أعطاني فقط بعض الاجهزة ( عدد 5 فقط من اجمالي يقارب المائة ) ، و لكن بتشغيل النموذج ثانية اعطي كل الاجهزة المفتوحة

و لكن لم يحدث ذلك ثانية عند التجربة لمرات لاحقة ، و أعطي النتيجة سليمة من أول مرة

كود ممتاز جدا ، مع الشكر و التحية :fff:

**أبو هادي** · مايو 27, 2004

السلام عليكم

شكرا جزيلا لك أخي محمد طاهر على جهودك المتواصلة .

لقد قمت بتصحيح الكود حتى يتفادى التوقف لتشغيله أول مرة .

طبعا تم تعديله على جهازي الخاص وبالطبع لن أستطيع أن أجربه حتى السبت ، ولكن يبدو لي أنه الآن سيعمل بدون مشاكل أن شاء الله .

Sub GetServerNames()
  Dim dbs As Database
  Dim rst As Recordset
  Dim NetPath As String
  Dim DbsPath As String
  Dim Pos As Integer
  Dim PathLen As Integer
  Dim RetVal
  Dim FS As Object
  Dim NewFile As Object
  Dim Count As Long
  Dim TextLine As String
  Dim Ct As String

  On Error Resume Next

  Ct = """"

  Set dbs = CurrentDb
  Set rst = dbs.OpenRecordset("Path", dbOpenSnapshot)
  NetPath = rst!Path
  rst.Close

  Pos = InStr(1, NetPath, "Net.exe")
  If Pos > 0 Then
    NetPath = Left(NetPath, Pos - 2)
  End If

  PathLen = Len(dbs.Name)
  For Pos = PathLen To 2 Step -1
    If Mid(dbs.Name, Pos, 1) = "\" Then
      DbsPath = Left(dbs.Name, Pos - 1)
      ChDrive Left(DbsPath, 1)
      ChDir DbsPath
      Exit For
    End If
  Next Pos

  Kill DbsPath & "\OnLineMachines.bat"
  Set FS = CreateObject("Scripting.FileSystemObject")
  Set NewFile = FS.CreateTextFile(DbsPath & "\OnLineMachines.bat", True)
  NewFile.WriteLine (NetPath & "\NET VIEW /NETWORK > " & Ct & CurDir & "\OnLineMachines.txt" & Ct)
  NewFile.Close

  RetVal = Shell("OnLineMachines.bat", vbHide)
  Set FS = Application.FileSearch
  With FS
    .LookIn = DbsPath
    .FileName = "OnLineMachines.txt"
    Do: Loop Until .Execute > 0
  End With
  Open "OnLineMachines.txt" For Input As #1

  DoCmd.RunSQL ("DELETE ServerNames.* FROM ServerNames;")
  Set rst = dbs.OpenRecordset("ServerNames", dbOpenDynaset)
  
  Do While Not EOF(1)
    Line Input #1, TextLine
    Pos = InStr(1, TextLine, "\\")
    If Pos > 0 Then
      With rst
        .AddNew
          !ServerName = RTrim(Mid(TextLine, 3, 20))
          !Remarks = RTrim(Mid(TextLine, 24, 50))
        .Update
      End With
    End If
  Loop

  Close #1
  rst.Close
  Set dbs = Nothing

  Kill DbsPath & "\OnLineMachines.bat"
  Kill DbsPath & "\OnLineMachines.txt"
End Sub

تحياتي .

تم تعديل مايو 29, 2004 بواسطه أبو هادي