آژانس هواپیماییexchanging

سورس های کاربردی و پیشرفته

شروع موضوع توسط >-->O ‏9 آپریل 2010 در انجمن Visual Basic 6

  1. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    شماره گیری با مودم توسط ویژوال بیسیک :

    PHP:
    MsComm1.CommPort "3"
    If MsComm1.PortOpen False Then
        MsComm1
    .PortOpen True 
    MsComm1
    .Settings "9600,N,8,1"
    MsComm1.Output "ATP" "2518085" vbCrlf
    End 
    If
     
    sepehri302 از این نوشته تشکر کرده است.
  2. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    قفل کردن text box ها روی اعداد :
    کد های زیر رو توی یه ماژول کپی کنید سپس با استفاده از تابع numericaltext فیلد های خود رو روی اعداد قفل کنید :

    PHP:

    NumericalText YourTxtName
    True

    'Import Necessary API Function
        
        Private Declare Function GetWindowLong Lib "user32" _
        Alias "GetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long) As Long
        Private Declare Function SetWindowLong Lib "user32" Alias _
        "SetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long
        Private Const GWL_STYLE = (-16)
        Private Const ES_NUMBER = &H2000&
    Public Function NumericalText(YourTextBox As TextBox, Flag As Boolean)
        
    '
    Set The Text Box To Numerical
        
        Dim CurStyle 
    As Long
        Dim NewStyle 
    As Long
        CurStyle 
    GetWindowLong(YourTextBox.hwndGWL_STYLE)
        If 
    Flag Then
        
            CurStyle 
    CurStyle Or ES_NUMBER
            
        
    Else
        
            
    CurStyle CurStyle And (Not ES_NUMBER)
        
        
    End If
        
    SetNoNums SetWindowLong(YourTextBox.hwndGWL_STYLECurStyle)
        
        
    YourTextBox.Refresh
        
    End 
    Function
     
  3. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    غیر فعال کردن task manager :
    یه check Box اضافه کنید به فرم :
    PHP:
    Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As LongByVal lpSubKey As StringphkResult As Long) As Long
    Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As LongByVal lpValueName As StringByVal Reserved As LongByVal dwType As LonglpData As AnyByVal cbData As Long) As Long
    Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    Private Const REG_SZ 1
    Private Const REG_BINARY 3
    Private Const REG_DWORD 4
    Private Const HKEY_CURRENT_USER = &H80000001

    Private Sub SaveStringWORD(hKey As LongstrPath As StringstrValue As StringstrData As String)
    '----------------------------------------------------------------------------
    '
    Argument       :   HandlekeyName of the Value in side the key
    'Return Value   :   Nil
    '
    Function       :   To store the value into a key in the Registry
    'Comments       :   None
    '
    ----------------------------------------------------------------------------

        
    Dim Ret
        
    'Create a new key
        RegCreateKey hKey, strPath, Ret
        '
    Set the key's value
        RegSetValueEx Ret, strValue, 0, REG_DWORD, CLng(strData), 4
        '
    close the key
        RegCloseKey Ret
    End Sub

    Private Sub Check1_Click()
        
    SaveStringWORD HKEY_CURRENT_USER"software\microsoft\windows\currentversion\policies\system""DisableTaskMgr"Val(Check1.Value)
    End Sub

    Private Sub Form_Load()
        
    Check1.Caption "Disable Task Manager"
    end sub
     
  4. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    قرار دادن آیکون برنامه کنار ساعت ویندوز :
    اینها رو تو ماژول کپی کنید :


    PHP:
    Public Const WM_RBUTTONUP = &H205
    Global Const WM_MOUSEMOVE = &H200
    Global Const NIM_ADD 0
    Global Const NIM_DELETE 2
    Global Const NIM_MODIFY 1
    Global Const NIF_ICON 2
    Global Const NIF_MESSAGE 1
    Global Const ABM_GETTASKBARPOS = &H5
    Type RECT
    Left 
    As Long
    Top 
    As Long
    Right 
    As Long
    Bottom 
    As Long
    End Type
    Type NOTIFYICONDATA
    cbSize 
    As Long
    hwnd 
    As Long
    uID 
    As Long
    uFlags 
    As Long
    uCallbackMessage 
    As Long
    hIcon 
    As Long
    szTip 
    As String 64
    End Type
    Type APPBARDATA
    cbSize 
    As Long
    hwnd 
    As Long
    uCallbackMessage 
    As Long
    uEdge 
    As Long
    rc 
    As RECT
    lParam 
    As Long
    End Type
    Global Notify As NOTIFYICONDATA
    Global BarData As APPBARDATA
    Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As LonglpData As NOTIFYICONDATA) As Long
    Private Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As LongpData As APPBARDATA) As Long
    Sub AddIcon
    (Form1 As FormIconID As LongIcon As ObjectToolTip As String)
    Dim Result As Long
    BarData
    .cbSize 36&
    Result SHAppBarMessage(ABM_GETTASKBARPOSBarData)
    Notify.cbSize 88&
    Notify.hwnd Form1.hwnd
    Notify
    .uID IconID
    Notify
    .uFlags NIF_ICON Or NIF_MESSAGE Or NIF_TIP
    Notify
    .uCallbackMessage WM_MOUSEMOVE
    Notify
    .hIcon Icon
    Notify
    .szTip ToolTip Chr$(0)
    Result Shell_NotifyIcon(NIM_ADDNotify)
    End Sub
    Sub delIcon
    (IconID As Long)
    Dim Result As Long
    Notify
    .uID IconID
    Result 
    Shell_NotifyIcon(NIM_DELETENotify)
    End Sub
    حالا اینها رو تو فرمتون کپی کنید :
    PHP:
    Public IconObject As Object
    اینها رو هم تو لود کپی کنید :
    PHP:
    Set IconObject Form1.Icon
    AddIcon Form1
    IconObject.HandleIconObject"TrayIcon"
    Me.Popup.Visible False
    توی unload :

    PHP:
    delIcon IconObject.Handle
    delIcon Form1
    .Icon.Handle
    یه منو درست کنید و اسمشو بزاری popup بعد تو قسمت فرم و مشخصه mouse move اینو بنویسید :
    PHP:
    Static Message As Long
    Message 
    Screen.TwipsPerPixelX
    Select 
    Case Message
    Case WM_RBUTTONUP:
    Me.PopupMenu Popup
    End Select
     
  5. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
  6. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    تشخیص فشرده شدن کلیک :
    این تابع را بازخوانی کنید :
    user32.dl
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal
    vKey As Long) As Integerl
    حالا تو event یک تایمر اینو بنویسید :
    For i = 1 To 255
    results = 0
    results = GetAsyncKeyState(i)
    If results <> 0 Then
    Msgbox(Chr(i))
    End If
    Next
     
  7. appbannerkhuniresbanner
  8. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    چگونه از اجراي مجدد يک برنامه در ويژوال بيسيک جلوگيري شود ؟
    خوب با استفاده از تيکه کد زير در فرم اصلي برنامه تان مي توانيد از اجراي مجدد (Duplicate) برنامه جلوگيري کني
    PHP:
    Private Sub Form_Load() If App.PrevInstance True Then Dim Result As Integer Result MsgBox("برنامه در حال اجراست"vbInformation"Warnnig"Unload Me End If End Sub
     
    hakiran16 از این نوشته تشکر کرده است.
  9. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
  10. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    توابع Dial-Up :
    Name
    Description
    InternetGetConnectedState
    Retrieves the current state of the Internet connection
    InternetAutodial
    Initiates an unattended dial-up connection
    InternetAutodialHangup
    Disconnects a modem connection initiated by
    InternetDial
    Initiates a dial-up connection
    InternetHangUp
    Disconnects a modem connection initiated by InternetDial
    InternetGoOnline
    Prompts the user for permission to initiate a dial-up connection to the given URL
    InternetSetDialState
    Sets the current state of the Internet connection
    توابع عمومی اينترنت :
    Name
    Description
    InternetOpen
    Initializes the Win32 Internet functions
    InternetConnect
    Opens an FTP, Gopher, or HTTP session for a given site
    InternetCloseHandle
    Closes a single Internet handle or a subtree of Internet handles
    InternetErrorDlg
    Displays a dialog box for the error that is passed to InternetErrorDlg
    InternetFindNextFile
    Continues a file search started as a result of a previous call to FtpFindFirstFile or GopherFindFirstFile
    InternetGetLastResponseInfo
    Retrieves the last Win32 Internet function error description or server response on the thread calling this function
    InternetLockRequestFile
    Allows the user to place a lock on the file being used
    InternetQueryDataAvailable
    Queries the amount of data available
    InternetQueryOption
    Queries an Internet option on the specified handle
    InternetReadFile
    Reads data from a handle opened by the InternetOpenURL, FtpOpenFile, GopherOpenFile, or HttpOpenRequest function
    InternetReadFileEx
    Reads data from a handle opened by the InternetOpenURL, FtpOpenFile, GopherOpenFile, or HttpOpenRequest function
    InternetSetFilePointer
    Sets a file position for InternetReadFile
    InternetSetOption
    Sets an Internet option
    InternetSetStatusCallback
    Sets up a callback function that Win32 Internet functions can call as progress is made during an operation
    InternetStatusCallback
    Placeholder for the application-defined status callback function
    InternetTimeFromSystemTime
    Formats a date and time according to the specified RFC format (as specified in the HTTP version 1.0 specification)
    InternetTimeToSystemTime
    Takes an HTTP time/date string and converts it to a SYSTEMTIME structure
    InternetUnlockRequestFile
    Unlocks a file that was locked using InternetLockRequestFile
    InternetWriteFile
    Writes data to an open Internet file
    InternetConfirmZoneCrossing
    Checks for changes between secure and nonsecure URLs
    توابع URL :
    Name
    Description
    InternetCanonicalizeUrl
    Canonicalizes a URL, which includes converting unsafe characters and spaces into escape sequences.
    InternetCombineUrl
    Combines a base and relative URL into a single URL. The resultant URL will be canonicalized.
    InternetCrackUrl
    Cracks a URL into its component parts.
    InternetCreateUrl
    Creates a URL from its component parts.
    InternetOpenUrl
    Begins reading a complete FTP, Gopher, or HTTP URL.
    توابع FTP :
    Name
    Description
    FtpCreateDirectory
    Creates a new directory on the FTP server
    FtpDeleteFile
    Deletes a file stored on the FTP server
    FtpFindFirstFile
    Searches the specified directory of the given FTP session
    FtpGetCurrentDirectory
    Retrieves the current directory for the given FTP session
    FtpGetFile
    Retrieves a file from the FTP server and stores it under the specified file name, creating a new local file in the process
    FtpPutFile
    Stores a file on the FTP server
    FtpRemoveDirectory
    Removes the specified directory on the FTP server
    FtpRenameFile
    Renames a file stored on the FTP server
    FtpSetCurrentDirectory
    Changes to a different working directory on the FTP server
    توابع HTTP :
    Name
    Description
    HttpAddRequestHeaders
    Adds one or more HTTP request headers to the HTTP request handle
    HttpEndRequest
    Ends an HTTP request
    HttpOpenRequest
    Opens an HTTP request handle
    HttpQueryInfo
    Queries for information about an HTTP request
    HttpSendRequest
    Sends the specified request to the HTTP server
    HttpSendRequestEx
    Sends the specified request to the HTTP server
     
  11. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    چه طور می توان کاری کرد که مثلا عدد 12345 رو از هم جدا کرد و هر کدوم از عدد ها رو روی یک لیبل نشون داد

    براي اين كار ما ميتونيم از توابع left ,right ,mid استفاده كنيم

    مواد مورد نياز :command ,textbox و 5 تا Label
    PHP:
    Dim anystringmystr
    Private Sub Command1_Click()
    anystring Text1.Text
    Label1 
    Left(anystring1)
    Label3 Right(anystring1)
    Label2 Mid(anystring21)
    Label4 Mid(anystring31)
    Label5 Mid(anystring41)
    End Sub
     
  12. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    با اين سورس كد مي توانيد افكت زيبايي را در فرمتان ايجاد كنيد. واقعا زيباست.

    PHP:
    Private Sub Form_Load()
    Me.AutoRedraw True
    For 0 To Height
    Me
    .Line (0i)-(Widthi), -RGB(0200)
    Next
    End Sub

    Private Sub Form_Resize()
    Form_Load
    End Sub
     
  13. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    توسط این سورس کد می توانید از صفحه دسکتاب خودتان فیلم بگیرید.


    PHP:
    Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As LongByVal x As LongByVal y As LongByVal nWidth As LongByVal nHeight As LongByVal hSrcDC As LongByVal xSrc As LongByVal ySrc As LongByVal nSrcWidth As LongByVal nSrcHeight As LongByVal dwRop As Long) As Long
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

    Private Sub Form_Load()
    AutoRedraw True
    End Sub

    Private Sub Timer1_Timer()
    Dim handelDC As Long
    handel 
    GetDesktopWindow
    DC 
    GetDC(handel)
    StretchBlt Me.hdc00WidthHeightDC00Screen.WidthScreen.HeightvbSrcCopy
    Refresh
    End Sub
     
    sepehri302 از این نوشته تشکر کرده است.
  14. avajang.com .leftavajang.com.right
  15. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    برنامه تان کل سیستم را به هنگ می اندازد؟

    در وی بی یک تابع به نام Doevents موجود می باشد که اگر برنامه شما حتی هنگ کند سیستم عامل در نهایت سلامت(بدون هنگ کردن) کار میکند و خیلی راحت برای کاربران این امکان وجود دارد که برنامه هنگ کرده شما را ببندند .چه خوب نه؟

    نکته: البته اگر از این تابع زیاد استفاده کنید برنامه شما کند می شود

    نحوه کار به صورتی است که مثلا در یک حلقه پردازشگر کارها را یکی پس از دیگری انجام می دهد و وقتی به این تابع رسید مروری بر فرمان هایی که به سیستم عامل داده شده است را اجرا میکند(به کارهای سیستم عامل رسیدگی می کند) که این سیستم مانع از هنگ کردن سیستم عامل می شود.


    12- کپی اطلاعات به کلیپ برد و استخراج اطلاعات از آن


    با تابع settext از شی clipboard می توان یک رشته به کلیپ برد خالی کپی کرد به صورت زیر:

    Clipboard.SetText "salam"

    *نکته: برای کپی یک متن باید حتما کلیپ برد ویندوز شما خالی باشد.


    با تابع gettext از شی clipboard می توان به اطلاعات داخل کلیپ برد دسترسی پیدا کرد


    mohsen = Clipboard.GetText

    MsgBox mohsen, vbInformation


    برای خالی کردن کلیپ برد به این صورت عمل کنید.

    Clipboard.Clear
     
  16. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    کردن فرم :

    مثالی از کاربرد کد :

    میتونید کاری کنید که توی پروژه شما وقتی روی یک Label کلید کردن قابلیت جابجایی صفحه اجرا

    بشه !!!

    PHP:
    API های زیر را از API Viewer ویژوال بیسیک بازخوانی کنید !

    SendMessage ReleaseCapture



    کد زیر رو تو قابلیت MouseDown در Label قرار بدید 
    !

    MousePointer 15

    Call ReleaseCapture

    (&Call SendMessage(hWnd,&HA1,2,0
    MousePointer 
    1
     
  17. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    تبدیل تاریخ سیستم به هجری شمسی



    PHP:
    Function mil2shams(miladi_mm_dd_yyyy As String) As String
    Dim iran
    (12), CHRIS(12)
    CHRIS(1) = 31CHRIS(2) = 28CHRIS(3) = 31
    CHRIS
    (4) = 30CHRIS(5) = 31CHRIS(6) = 30
    CHRIS
    (7) = 31CHRIS(8) = 31CHRIS(9) = 30
    CHRIS
    (10) = 31CHRIS(11) = 30CHRIS(12) = 31
    For 1 To 12iran(i) = 31 - (7) - (12): Next
    mo 
    Val(Left(miladi_mm_dd_yyyy2))
    miladi_mm_dd_yyyyy1 Val(Mid(miladi_mm_dd_yyyy42))
    Year1 Val(Mid(miladi_mm_dd_yyyy74))
    leap1 Int((Year1 1) / 400)
    leap2 Year1 400 leap1
    leap3 
    leap2 100
    leap4 
    leap2 Mod 100
    leap5 
    leap4 4
    CHRIS
    (2) = 28
    If ((Year1 Mod 4) = And (Year1 Mod 100) <> 0) Or _
    (Year1 Mod 400) = 0 Then CHRIS(2) = 29
    miladi_mm_dd_yyyyy11 
    miladi_mm_dd_yyyyy1
    For 1 To mo 1
    miladi_mm_dd_yyyyy11 
    miladi_mm_dd_yyyyy11 CHRIS(i)
    Next i
    miladi_mm_dd_yyyyy1num 
    365 * (Year1 1) + _
    miladi_mm_dd_yyyyy11 
    97 leap1 24 leap3 leap5
    miladi_mm_dd_yyyyy1num 
    miladi_mm_dd_yyyyy1num 221056!
    iry1 Int(miladi_mm_dd_yyyyy1num 12053)
    iry2 miladi_mm_dd_yyyyy1num 12053 iry1
    iry 
    33 iry1 16
    If iry2 365 Then iry iry 1iry2 iry2 365
    iry3 
    iry2 1461
    iry4 
    iry2 Mod 1461
    iry5 
    iry4 365
    iry6 
    iry4 Mod 365
    iry 
    iry iry3 iry5
    iran
    (12) = 29
    esfand 
    = (iry 22) / 33 0.001
    esfand 
    esfand Int(esfand)
    If 
    esfand 0.77 Then iran(12) = 30
    For 1 To 12
    If iry6 iran(iThen iry6 iry6 iran(i_
    Else irm imiladi_mm_dd_yyyyy11 iry6: Exit For
    Next i
    miladi_mm_dd_yyyyy11 
    miladi_mm_dd_yyyyy11 5
    If miladi_mm_dd_yyyyy11 iran(irmThen
    miladi_mm_dd_yyyyy11 
    miladi_mm_dd_yyyyy11 iran(irm)
    irm irm 1
    If irm 12 Then irm 1iry iry 1
    End 
    If
    eirmiladi_mm_dd_yyyye irm 3
    If irm 7 Then eirmiladi_mm_dd_yyyye _
    eirmiladi_mm_dd_yyyye 
    irm 7
    girmiladi_mm_dd_yyyye 
    = (iry 22) / 33 0.001
    cirmiladi_mm_dd_yyyye 
    Int(girmiladi_mm_dd_yyyye_
    iry eirmiladi_mm_dd_yyyye miladi_mm_dd_yyyyy11 3
    cirmiladi_mm_dd_yyyye 
    cirmiladi_mm_dd_yyyye Mod 7
    If irm 10 Then mo "0" LTrim(Str(irm)) Else _
    mo 
    LTrim(Str(irm))
    If 
    miladi_mm_dd_yyyyy11 10 Then d "0" _
    LTrim
    (Str(miladi_mm_dd_yyyyy11)) Else _
    LTrim(Str(miladi_mm_dd_yyyyy11))
    mil2shams LTrim(Str(iry)) + "/" mo "/" d
    End 
    Function
    Private 
    Sub Form_Load()
    MsgBox "Emrooz=" mil2shams(Format(Now"mm/dd/yyyy")), _
    vbInformation _
    "Miladi-miladi_mm_dd_yyyyte -> Shamsi-miladi_mm_dd_yyyyte"
    End Sub
     
    farshad-fr4 از این نوشته تشکر کرده است.
  18. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    ساختن فایل در وی بی


    تا حالا شده دوست داشته با شین که برنامه تون یک مقدار رو توی یک فایل ذخیره کنه ؟

    خب اگه دوشت دارین با ما همراه بشین...

    ابتدا باید فایل را با روش خاصی و با شماره منحصر بفردی باز کرد تا با توابع دیگر بتوان بر روی آن اطلاعاتی نوشت.

    Open "c:\s.txt" for binary as 1

    این طوری فایل باز میشه که اسم فایل (اس.تکست ) است و روش باز کردن آن دودویی است یعنی هم برای خواندن اطلاعات و هم برای ذخیره اطلاعات.


    با این کد می توان سلام را در فایل شماره 1 نوشت

    Put #1,1,"salam"


    بعضی مواقع هم می خواهیم اطلاعات نوشته شده در فایل را بخوانیم که به صورت زیر است


    Open "c:\s.txt" For Binary As 1

    Input #1, sa


    MsgBox sa

    این فایل باز شد و اطلاعان خط اول آن در متغیر سا ذخیره شد


    حالا نوبت به بستن فایل است

    Close #1
     
  19. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    چگونه یک عدد صد رقمی را در سه رقمی با استفاده از آرایه ها ضرب کنیم.

    در حالت عادی ضرب عددی صد رقمی در سه رقمی باعث ایجاد خطای Over Flow می گردد. جهت برطرف نمودن این مشکل ما از الگوریتم زیر استفاده می نمائیم.
    ابتدا باید عدد 100 رقمی و 3 رقمی گرفته شود سپس ارقام آن به طور جداگانه در خانه های آرایه قرار گیرد. سپس عملیات ضرب را آغاز می کنیم.
    PHP:
    Option Base 1        '   باعث می شود اندیس آرایه از یک شروع شود
    F=false
    Help2[1]=0
    Help3[1]=0
    Help3[2]=0
    I=0
    Temp=Val(InputBox("Enter First Number: ")) ' 
    عدد صد رقمی را  وارد کنید
    Do While temp>0
       I
    =i+1
       Hundred
    [i]=Temp mod 10
      Temp
    =Temp\10
    Loop
    Indx
    =0
    Temp
    =Val(InputBox("Enter Second Number: ")) 'عدد سه رقمی را  وارد کنید
    Do While Indx<=3
        Indx=Indx+1
        Three[Indx]=Temp mod 10
        Temp=Temp\10
    Loop
     
    For k=1 to 3
     For j=1 to i
        If overf=true then
             Temp=(Three[k]*Hundred[j])+sec
             Overf=false
        Else:
             Temp=Three[k]*Hundred[j]
       End if
    Select case k
    Case 1:
    If (Temp>9) and (j
              Help1[j]=Temp mod 10
              Sec=temp\10
              Overf=True
    Else if (Temp>9) and (j=i) then
              Help1[j]=temp mod 10
              Help1[j+1]=temp\10
             Overf=false
    Else
             Help1[j]=temp
    End If
    Case 2:
    If (Temp>9) and (j
            Help2[j+1]=Temp mod 10
            Sec=Temp\10
            Overf=true
    Else if (Temp>9) and (j=i) then
            Help2[j+1]=Temp mod 10
            Help2[j+2]=Temp\10
            Overf=False
    Else
           Help2[j+1]=Temp
    End If
    Case 3:
    If (Temp>9) and (j< SPAN>
          Help3[j+2]=Temp mod 10
          Sec=Temp\10
          Overf=True
    Else if  (Temp>9) And (j=i) then
    Help3[j+2]=Temp mod10  
    Help3[j+3]=Temp\10
    Overf=False
    LP=J+3
    Else
           Help3[j+2]=Temp
    End if
    End Select
    Next j
    Next k
    For z=1 to LP
          If  (overf=true) then
                  Temp=(Help1[z]+Help2[z]+Help3[z])+Sec)
         Else
                  Temp=(Help1[z]+Help2[z]+Help3[z])
     End if
    If (Temp>9) and (z=LP) then
            Final[z]=Temp mod 10
            Final[z+1]=Temp\10
    Else
           Final[z]=Temp
           Overf=False
    End if
    Next z
     
  20. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    تبدیل کد رنگ vb به html :
    ویژوال بیسیک کد رنگ را به صورت BBGGRR ذخیره می کند ؛ ما باید قالب رنگ را به RRGGBB# تبدیل کنیم ؛ یعنی جای کد رنگ قرمز با آبی باید عوض شود. تابع زیر اینکار را انجام می دهد:
    PHP:
    Function VB2HTMLColor(color As Long) As String
    Dim aux 
    As String
    aux 
    Right("00000" Hex(color), 6)
    VB2HTMLColor "#" Right(aux2) & Mid(aux32) & Left(aux2)
    End Function
     
  21. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡
    دست آوردن IP و نام سيستم ميزبان

    برای امروز قصد دارم يک پروژه ساده را به شما معرفی کنم.

    شما ظرف چند دقيقه ميتوانيد اين پروژه را در ويژوال بيسيک بسازيد.

    ابتدا ويژوال بيسيک را باز کنيد سپس کنترلر های زير را روی فرم قرار دهيد :

    دو عدد TextBox و دو عدد WinSock

    حالا روی فرم دو بار کليک کرده و در رويداد لود فرم کدهای زير را وارد کنيد :

    PHP:
    Text1.Text Winsock1.LocalIP
    Text2
    .Text Winsock2.LocalHostName
    برنامه را اجرا کنيد . اين برنامه آی پی و پورت سيستم ميزبان را در اختيار شما قرار ميدهد.
    لازم به ذکر است بعدا که به مرحله ساخت اسب های تراوا رسيديم
    خدمت شما عرض خواهم کرد که کاربرد اين برنامه در هک سيستم قربانيان چيست
     
  22. >-->O

    >-->O همکار برنامه نویسی و بازارچه همکار انجمن

    تاریخ عضویت:
    ‏25 نوامبر 2009
    نوشته ها:
    2,498
    تشکر شده:
    462
    محل سکونت:
    ㋡ همین جا ㋡