یادداشت های برنامه نویس

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

یادداشت های برنامه نویس

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

صدا زدن اینترنت اکسپلورر از درون دلفی

program IExplor;

uses
  Windows, OLEAuto;

procedure OpenInternetExplorer(sURL: string);
const
  csOLEObjName = 'InternetExplorer.Application';
var
  IE        : Variant;
  WinHandle : HWnd;
begin
  if VarIsEmpty(IE) then
  begin
    IE := CreateOleObject(csOLEObjName);
    IE.Visible := true;
    IE.Navigate(sURL);
  end
  else
  begin
    WinHandle := FindWIndow('IEFrame', nil);
    if(0 <> WinHandle) then
    begin
      IE.Navigate(sURL);
      SetForegroundWindow(WinHandle);
    end
    else
    begin
      // handle error ...
    end;
  end;
end;

begin
  OpenInternetExplorer('http://lear4u.blogsky.com/');
end

اجرای فرامین dos و نمایش خروجی

function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  BytesRead: Cardinal;
  WorkDir: string;
  Handle: Boolean;
begin
  Result := '';
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    WorkDir := Work;
    Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
                            nil, nil, True, 0, nil,
                            PChar(WorkDir), SI, PI);
    CloseHandle(StdOutPipeWrite);
    if Handle then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            Result := Result + Buffer;
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;

غیرفعال کردن ctrl+n در web browser

procedure TfrmMyBrowser.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  
// check if Ctrl-N pressed
  
if (GetKeyState(VK_CONTROL) < 0) and (Msg.Message = WM_KEYDOWN) and
    
(Msg.wParam = Ord('N')) then
  begin
    
Handled := True;
  end;
end;

بدست آوردن تمامی عکس های درون یک صفحه وب

uses mshtml, ActiveX, COMObj, IdHTTP, idURI;
{ .... }
procedure GetImageLinks(AURL: string; AList: TStrings);
var IDoc: IHTMLDocument2;
    strHTML: string;
    v: Variant;
    x: Integer;
    ovLinks: OleVariant;
    DocURL: string;
    URI: TidURI;
    ImgURL: string;
    idHTTP: TidHTTP;
    begin
    AList.Clear;
    URI := TidURI.Create(AURL);
    try
    DocURL := 'http://' + URI.Host;
    if URI.Path <> '/' then
    DocURL := DocURL + URI.Path;
    finally
    URI.Free;
    end;
    Idoc := CreateComObject(Class_HTMLDocument) as IHTMLDocument2;
    try
    IDoc.designMode := 'on';
    while     IDoc.readyState <> 'complete' do
    Application.ProcessMessages;
    v := VarArrayCreate([0, 0], VarVariant);
    idHTTP := TidHTTP.Create(nil);
    try
    strHTML := idHTTP.Get(AURL);
    finally
    idHTTP.Free;
    end;
    v[0] := strHTML;
    IDoc.Write(PSafeArray(System.TVarData(v).VArray));
    IDoc.designMode := 'off';
    while     IDoc.readyState <> 'complete' do
    Application.ProcessMessages;
    ovLinks := IDoc.all.tags('IMG');
    if ovLinks.Length > 0 then begin
    for x := 0 to ovLinks.Length - 1 do begin
    ImgURL := ovLinks.Item(x).src;
    if (ImgURL[1] = '/') then begin
    ImgURL := DocURL + ImgUrl;
    end
    else
    begin
    if (Copy(ImgURL, 1, 11) = 'about:blank') then begin
    ImgURL := DocURL + Copy(ImgUrl, 12, Length(ImgURL));
    end;
    end;
    AList.Add(ImgURL);
    end;
    end;
    finally
    IDoc := nil;
    end;
    end;
روش استفاده////
 Example:
 procedure TForm1.Button1Click(Sender: TObject);
 begin GetImageLinks('http://lear4u.blogsky.com', Memo1.Lines);
 end

آیا url به صورت کامل باز شده است؟

  procedure pause(const ADelay: LongWord);
  var
    StartTC: DWORD;
    CurrentTC: Int64;
  begin
    StartTC := GetTickCount;
    repeat
      Application.ProcessMessages;
      CurrentTC := GetTickCount;
      if CurrentTC < StartTC then
        // tick count has wrapped around: adjust it
        CurrentTC := CurrentTC + High(DWORD);
    until CurrentTC - StartTC >= ADelay;
  end;

begin
  WebBrowser1.Navigate('http://lear4u.blogsky.com');
  while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do
    Pause(5); // 5ms delay before re-testing
end;

انسان و الاغ

انسان و الاغ

انسان = خواب + خوراک + کار+ تفریح
الاغ = خواب + خوراک

پس
انسان = الاغ + کار + تفریح

وبنابرین
تفریح – انسان = الاغ + کار

بعبارت دیگر
انسانی که تفریح ندارد = الاغی که فقط کار می کند

*****
معادله ۲

مرد = خواب + خوراک + درآمد
الاغ = خواب + خوراک

پس
مرد = الاغ + درآمد

و بنابرین
درآمد – مرد = الاغ

بعبارت دیگر
مردی که درآمد ندارد = الاغ

*****
معادله ۳

زن = خواب + خوراک + خرج پول
الاغ = خواب + خوراک

پس
زن = الاغ + خرج پول

وبنابرین
خرج پول – زن= الاغ

بعبارت دیگر
زنی که پول خرج نمی کند = الاغ

*****
نتیجه گیری:

از معادلات ۲و۳ داریم:
مردی که درآمد ندارد = زنی که پول خرج نمیکند

پس:
فرض منطقی ۱: مردها درآمد دارند تا نگذارند زنها تبدیل به الاغ شوند..
و
فرض منطقی ۲: زنها پول خرج می کنند تا نگذارند مردها تبدیل به الاغ شوند.

بنابرین داریم ...

مرد + زن = الاغ + درآمد + الاغ + خرج پول
و ازفرضهای۱و۲ نتیجه منطقی میگیریم که:
مرد + زن = ۲ الاغی که با هم بخوشی زندگی میکنند