Блог по программированию в среде Delphi

Поиск по блогу

Есть идея по созданию интересной программы?

Опиши тут и я по возможности постараюсь это реализовать специально для тебя! Без $ ))
Показаны сообщения с ярлыком Функции. Показать все сообщения
Показаны сообщения с ярлыком Функции. Показать все сообщения

воскресенье, 27 февраля 2011 г.

Функция получения PageRank (Delphi)


Ни так давно захотел определить PR блога без SEO сервисов с помощью Delphi.
Все оказалось ни так просто, как на Yandex'e при определении ТИЦ'а. Чтобы получить ТИЦ для тех, кто не знает или просто ни когда об этом, ни задумывался, необходимо выполнить запрос такого вида:
http://search.yaca.yandex.ru/yca/cy/ch/[URL сайта без http:\\]/

Пример:
http://search.yaca.yandex.ru/yca/cy/ch/nmdsoft.blogspot.com/
 

и немного распарсить страницу и получим искомый нами ТИЦ

пятница, 7 января 2011 г.

Отправка файла Synapse

Код функции по отправке файла
Автор: Eric Paschoalick Chaves

function HttpPostFileForm(const URL, FieldName, FileName: string; const Data: TStream; const FormFields:TStrings; const ResultData:
TStrings): Boolean;
var
  HTTP: THTTPSend;
  Bound, s: AnsiString;//был string, но для России не катит ( ! )
  i:integer;
const
  CRLF=#13#10;
  FIELD_MASK = CRLF + '--%s' + CRLF +'Content-Disposition: form-data; name="%s"' + CRLF + CRLF+'%s';
begin
  Bound := IntToHex(Random(MaxInt), 8) + '_Synapse_boundary';
  HTTP := THTTPSend.Create;
  try
    s := '--' + Bound + CRLF;
    s := s + 'content-disposition: form-data; name="' + FieldName +'";';
    s := s + ' filename="' + FileName +'"' + CRLF;
    s := s + 'Content-Type: Application/octet-string' + CRLF + CRLF;
    HTTP.Document.Write(Pointer(s)^, Length(s));
    HTTP.Document.CopyFrom(Data, 0);
    // Include formfield
    for i:=0 to FormFields.Count-1 do
      begin
        S:= Format(FIELD_MASK,[Bound, FormFields.Names[I],FormFields.Values[FormFields.Names[I]]]);
        HTTP.Document.Write(Pointer(S)^, Length(S));
      end;
    s := CRLF + '--' + Bound + '--' + CRLF;
    HTTP.Document.Write(Pointer(s)^, Length(s));
    HTTP.MimeType := 'multipart/form-data, boundary=' + Bound;
    Result := HTTP.HTTPMethod('POST', URL);
    ResultData.LoadFromStream(HTTP.Document);
  finally
    HTTP.Free;
  end;
end;

пятница, 19 ноября 2010 г.

Время простоя ПК

function CheckIddleTime: DWord;
var
   LastInput: TLastInputInfo;
begin
   LastInput.cbSize := SizeOf(TLastInputInfo);
   GetLastInputInfo(LastInput);
   Result := GetTickCount - LastInput.dwTime;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Caption:= 'Время простоя: ' + vartostr(CheckIddleTime/1000)+' секунд(ы)';
end;

суббота, 11 сентября 2010 г.

Загрузка изображения из интернета в поток (Delphi)

uses wininet;

function LoadImage(url:string): TMemoryStream;
var
  hInternet, hConnect: pointer;
  dwBytesRead, i, L: cardinal;
  sTemp: AnsiString;
begin
  Result:=TMemoryStream.Create;
  hInternet := InternetOpen('MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  try
    if Assigned(hInternet) then
    begin
      hConnect := InternetOpenUrl(hInternet, PChar(url), nil, 0, 0, 0);
      if Assigned(hConnect) then
        try
          i := 1;
          repeat
            SetLength(sTemp, L + i);
            if not InternetReadFile(hConnect, @sTemp[i], sizeof(L),dwBytesRead) then
              break;
            inc(i, dwBytesRead);
            until dwBytesRead = 0;
        finally
          InternetCloseHandle(hConnect);
        end;
    end;
  finally
    InternetCloseHandle(hInternet);
  end;
  Result.Write(sTemp[1], Length(sTemp));
  Result.Position := 0;
end;

Данную функцию использовал для загрузки изображений с различными форматами:
bmp, gif, png, jpeg, tiff, ico и др. Проблем не возникало. Главное, что необходимо сделать это сохранять картинки с теми же расширениями которые у них были, чтобы потом не возникало путаницы. Я сохранял с именами файлов которые брал из прямых ссылок на картинки.

Для получения имени файла из Url использую функцию

function ExtractUrlFileName(const AUrl: string): string;
var
  i: Integer;
begin
  i := LastDelimiter('/', AUrl);
  Result := Copy(AUrl, i + 1, Length(AUrl) - (i));
end;

вторник, 27 июля 2010 г.

Функция по загрузке jpg в Timage (Delphi)

Не скажу, что прям моя разработка, но к ней я свою корявую руку приложил))

//непосредственно сама функция по загрузке картинки формата jpg из сети интернет
//для работы функции необходимо добавить в uses ... wininet, Jpeg;


function GetImage(url:string): TPicture;
var
  hInternet, hConnect: pointer;
  dwBytesRead, i, L: cardinal;
  sTemp,aUrl: AnsiString; // текст страницы
  memStream: TMemoryStream;
  jpegimg: TJPEGImage;
begin
  hInternet := InternetOpen('MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  try
    if Assigned(hInternet) then
    begin
      hConnect := InternetOpenUrl(hInternet, PChar(url), nil, 0, 0, 0);
      if Assigned(hConnect) then
        try
          i := 1;
          repeat
            SetLength(sTemp, L + i);
            if not InternetReadFile(hConnect, @sTemp[i], sizeof(L),dwBytesRead) then
              break; // Получаем данные с сервера
            inc(i, dwBytesRead);
            until dwBytesRead = 0;
        finally
          InternetCloseHandle(hConnect);
        end;
    end;
  finally
    InternetCloseHandle(hInternet);
  end;
  memStream := TMemoryStream.Create;
  jpegimg := TJPEGImage.Create;
  try
    memStream.Write(sTemp[1], Length(sTemp));
    memStream.Position := 0;
    //загрузка изображения из потока
    jpegimg.LoadFromStream(memStream);
    Result:=TPicture.Create;
    Result.Assign(jpegimg);
  finally
    //очистка
    memStream.Free;
    jpegimg.Free;
  end;
end;