500+ FAQ по Delphi

Перейти на: Главную | Индексную | Предыдущую | Следующую страницу
ассортимент с высоким доходом товары мед назначения.
Как перевести RTF в HTML?

Здесь процедура, которую я использую для конвертации содержимого RichEdit
в код SGML. Она не создает полноценный HTML-файл, но Вы можете расширить
функциональность, указал, какие RTF-коды Вы желаете конвертировать в
какие-либо HTML-тэги.

function rtf2sgml (text : string) : string;
{Funktion for att konvertera en RTF-rad till SGML-text.}
var
temptext : string;
start : integer;
begin
text := stringreplaceall (text,'&','##amp;');
text := stringreplaceall (text,'##amp','&');
text := stringreplaceall (text,'\'+chr(39)+'e5','å');
text := stringreplaceall (text,'\'+chr(39)+'c5','Å');
text := stringreplaceall (text,'\'+chr(39)+'e4','ä');
text := stringreplaceall (text,'\'+chr(39)+'c4','Ä');
text := stringreplaceall (text,'\'+chr(39)+'f6','ö');
text := stringreplaceall (text,'\'+chr(39)+'d6','Ö');
text := stringreplaceall (text,'\'+chr(39)+'e9','é');
text := stringreplaceall (text,'\'+chr(39)+'c9','É');
text := stringreplaceall (text,'\'+chr(39)+'e1','á');
text := stringreplaceall (text,'\'+chr(39)+'c1','Á');
text := stringreplaceall (text,'\'+chr(39)+'e0','à');
text := stringreplaceall (text,'\'+chr(39)+'c0','À');
text := stringreplaceall (text,'\'+chr(39)+'f2','ò');
text := stringreplaceall (text,'\'+chr(39)+'d2','Ò');
text := stringreplaceall (text,'\'+chr(39)+'fc','ü');
text := stringreplaceall (text,'\'+chr(39)+'dc','Ü');
text := stringreplaceall (text,'\'+chr(39)+'a3','£');
text := stringreplaceall (text,'\}','#]#');
text := stringreplaceall (text,'\{','#[#');
text := stringreplaceall (text,'{\rtf1\ansi\deff0\deftab720','');{Skall alltid tas bort}
text := stringreplaceall (text,'{\fonttbl',''); {Skall alltid tas bort}
text := stringreplaceall (text,'{\f0\fnil MS Sans Serif;}','');{Skall alltid tas bort}
text := stringreplaceall (text,'{\f1\fnil\fcharset2 Symbol;}','');{Skall alltid tas bort}
text := stringreplaceall (text,'{\f2\fswiss\fprq2 System;}}','');{Skall alltid tas bort}
text := stringreplaceall (text,'{\colortbl\red0\green0\blue0;}','');{Skall alltid tas bort}
{I version 2.01 av Delphi finns inte \cf0 med i RTF-rutan. Tog darfor bort
det efter \fs16 och la istallet en egen tvatt av \cf0.}
//temptext := hamtastreng (text,'{\rtf1','\deflang');
//text := stringreplace (text,temptext,''); {Hamta och radera allt fran start till deflang}
text := stringreplaceall (text,'\cf0','');
temptext := hamtastreng (text,'\deflang','\pard');{Plocka fran deflang till pard for att fa }
text := stringreplace (text,temptext,'');{oavsett vilken lang det ar. Norska o svenska ar olika}
{Har skall vi plocka bort fs och flera olika siffror beroende pa vilka alternativ vi godkanner.}
//text := stringreplaceall (text,'\fs16','');{8 punkter}
//text := stringreplaceall (text,'\fs20','');{10 punkter}
{Nu stadar vi istallet bort alla tvasiffriga fontsize.}
while pos ('\fs',text) >0 do
begin
application.processmessages;
start := pos ('\fs',text);
Delete(text,start,5);
end;
text := stringreplaceall (text,'\pard\plain\f0 ','<P>');
text := stringreplaceall (text,'\par \plain\f0\b\ul ','</P><MELLIS>');
text := stringreplaceall (text,'\plain\f0\b\ul ','</P><MELLIS>');
text := stringreplaceall (text,'\plain\f0','</MELLIS>');
text := stringreplaceall (text,'\par }','</P>');
text := stringreplaceall (text,'\par ','</P><P>');
text := stringreplaceall (text,'#]#','}');
text := stringreplaceall (text,'#[#','{');
text := stringreplaceall (text,'\\','\');
result := text;
end;

//This is cut directly from the middle of a fairly long save routine that calls the above function.
//I know I could use streams instead of going through a separate file but I have not had the time to change this

utfilnamn := mditted.exepath+stringreplace(stringreplace(extractfilename(pathname),'.TTT',''),'.ttt','') + 'ut.RTF';
brodtext.lines.savetofile (utfilnamn);
temptext := '';
assignfile(tempF,utfilnamn);
reset (tempF);
try
while not eof(tempF) do
begin
readln (tempF,temptext2);
temptext2 := stringreplaceall (temptext2,'\'+chr(39)+'b6','');
temptext2 := rtf2sgml (temptext2);
if temptext2 <>'' then temptext := temptext+temptext2;
application.processmessages;
end;
finally
closefile (tempF);
end;
deletefile (utfilnamn);
temptext := stringreplaceall (temptext,'</MELLIS> ','</MELLIS>');
temptext := stringreplaceall (temptext,'</P> ','</P>');
temptext := stringreplaceall (temptext,'</P>'+chr(0),'</P>');
temptext := stringreplaceall (temptext,'</MELLIS></P>','</MELLIS>');
temptext := stringreplaceall (temptext,'<P></P>','');
temptext := stringreplaceall (temptext,'</P><P></MELLIS>','</MELLIS><P>');
temptext := stringreplaceall (temptext,'</MELLIS>','<#MELLIS><P>');
temptext := stringreplaceall (temptext,'<#MELLIS>','</MELLIS>');
temptext := stringreplaceall (temptext,'<P><P>','<P>');
temptext := stringreplaceall (temptext,'<P> ','<P>');
temptext := stringreplaceall (temptext,'<P>-','<P>_');
temptext := stringreplaceall (temptext,'<P>_','<CITAT>_');
while pos('<CITAT>_',temptext)>0 do
begin
application.processmessages;
temptext2 := hamtastreng (temptext,'<CITAT>_','</P>');
temptext := stringreplace (temptext,temptext2+'</P>',temptext2+'</CITAT>');
temptext := stringreplace (temptext,'<CITAT>_','<CITAT>-');
end;
writeln (F,'<BRODTEXT>'+temptext+'</BRODTEXT>');
Как преобразовать ICO в BMP?

Попробуй:

var
Icon : TIcon;
Bitmap : TBitmap;
begin
Icon := TIcon.Create;
Bitmap := TBitmap.Create;
Icon.LoadFromFile('c:\picture.ico');
Bitmap.Width := Icon.Width;
Bitmap.Height := Icon.Height;
Bitmap.Canvas.Draw(0, 0, Icon );
Bitmap.SaveToFile('c:\picture.bmp');
Icon.Free;
Bitmap.Free;
end;
Как преобразовать BMP (32x32) в ICO?

Попробуй:

unit main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms,Dialogs,ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image2: TImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var winDC, srcdc, destdc : HDC;
oldBitmap : HBitmap;
iinfo : TICONINFO;
begin
GetIconInfo(Image1.Picture.Icon.Handle, iinfo);

WinDC := getDC(handle);
srcDC := CreateCompatibleDC(WinDC);
destDC := CreateCompatibleDC(WinDC);
oldBitmap := SelectObject(destDC, iinfo.hbmColor);
oldBitmap := SelectObject(srcDC, iinfo.hbmMask);

BitBlt(destdc, 0, 0, Image1.picture.icon.width,
Image1.picture.icon.height,
srcdc, 0, 0, SRCPAINT);
Image2.picture.bitmap.handle := SelectObject(destDC, oldBitmap);
DeleteDC(destDC);
DeleteDC(srcDC);
DeleteDC(WinDC);

image2.Picture.Bitmap.savetofile(ExtractFilePath(Application.ExeName)
+ 'myfile.bmp');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
image1.picture.icon.loadfromfile('c:\myicon.ico');
end;

end.
Как узнать кто висит на моей (или не моей) машине

#define STRICT
#include <windows.h>
#include <lm.h>
#include <iostream.h>
#include <tchar.h>

void UserEnum()
{
BOOL keepGoing = TRUE ;
DWORD entriesRead, totalEntries ;
USER_INFO_2 * pInfo = NULL ;
DWORD resumeHandle = 0 ; // must be 0 to start with
char nameBuf[ UNLEN + 1 ] ; // constants defined in LMCONS.H
char commentBuf[ MAXCOMMENTSZ + 1 ] ;
WCHAR serverName[ 100 ] ;
lstrcpyW( serverName, L"\\\\PDC" ) ; //L"" ) ;
while ( keepGoing )
{
NET_API_STATUS ret = NetUserEnum(
serverName, //NULL,
2,
0, //FILTER_NORMAL_ACCOUNT,
(LPBYTE *)&pInfo, // Important: ADDRESS of POINTER
sizeof( USER_INFO_2 ) * 100, // requested buffer size; it may not
actually allocate this much
&entriesRead,
&totalEntries,
&resumeHandle ) ;

keepGoing = ( ret == ERROR_MORE_DATA ) ;

if ( ret == 0 || ret == ERROR_MORE_DATA )
{
DWORD i ;
for ( i = 0 ; i < entriesRead ; i++ )
{
// Note that strings in the INFO structures
// will ALWAYS be Unicode, regardless of
// your settings! Even though they're declared
// as LPTSTR, they're always LPWSTR.
// I'm compiling for non-Unicode, so I
// convert them to ANSI strings...
// Check for NULL pointers in the INFO structure
LPWSTR pName = (LPWSTR)pInfo[ i ].usri2_name ;
LPWSTR pComm = (LPWSTR)pInfo[ i ].usri2_comment ;
if ( pName == NULL )
{
lstrcpy( nameBuf, "(no name!)" ) ;
}
else if ( lstrlenW( pName ) == 0 )
{
lstrcpy( nameBuf, "(empty name!)" ) ;
}
else
{
WideCharToMultiByte( CP_ACP, 0,
pName, -1,
nameBuf, UNLEN,
NULL, NULL ) ;
}
if ( pComm == NULL )
{
lstrcpy( commentBuf, "(no comment!)" ) ;
}
else if ( lstrlenW( pComm ) == 0 )
{
lstrcpy( commentBuf, "(empty comment!)" ) ;
}
else
{
WideCharToMultiByte( CP_ACP, 0,
pComm, -1,
commentBuf, MAXCOMMENTSZ,
NULL, NULL ) ;
}
cout << nameBuf << ": " << commentBuf << endl ;
}
}
else
{
cout << "NetUserEnum error " << ret << endl ;
}

if ( pInfo )
{
NetApiBufferFree( pInfo ) ;
pInfo = NULL ;
}
}
}
//****************************************************************************/
Как создать юзера и дать ему права?

NET_API_STATUS UserAdd(LPSTR username)
{

// некоторые используемые функции описаны в других QA

USER_INFO_2 user_info;

char compname[256];
wchar_t wcompname[256];
DWORD parm_err=0;
LSA_HANDLE PolicyHandle;

LPTSTR lpszSystemInfo; // ptr. to system info. string
DWORD cchBuff = 256; // size of comp. or user name
TCHAR tchBuffer2[256]; // buffer for concat'd. str.
WCHAR wGroupNameAdd[20]=L"Administrators";
lpszSystemInfo = tchBuffer2;
ZeroMemory(&user_info,sizeof(user_info));

GetComputerName(lpszSystemInfo, &cchBuff);
strcpy(compname,"\\\\");
strcat(compname,lpszSystemInfo);

mbstowcs( wcompname, compname, strlen(compname)+1 );
mbstowcs(user_info.usri2_name,username, strlen(username)+1 );

//-------создаем юзера------------//

user_info.usri2_password = L"";
user_info.usri2_priv = USER_PRIV_USER;
user_info.usri2_flags =
UF_SCRIPT|UF_PASSWD_CANT_CHANGE|UF_DONT_EXPIRE_PASSWD|UF_NORMAL_ACCOUNT;
user_info.usri2_acct_expires=TIMEQ_FOREVER;

NetUserAdd(wcompname,// PDC name
2L, // level
(LPBYTE)&user_info, // input buffer
&parm_err ); // parameter in error

GetAccountSid(
NULL, // default lookup logic
username, // account to obtain SID
&pSid // buffer to allocate to contain resultant SID
);

NetLocalGroupAddMember(0,wGroupNameAdd,pSid);

//---------даем ему кое-какие права-----------//

OpenPolicy(
wcompname, // target machine
POLICY_ALL_ACCESS, //POLICY_CREATE_ACCOUNT | POLICY_LOOKUP_NAMES,
&PolicyHandle // resultant policy handle
);


SetPrivilegeOnAccount(
PolicyHandle, // policy handle
pSid, // SID to grant privilege
L"SeInteractiveLogonRight", // Unicode privilege
TRUE // enable the privilege
);

SetPrivilegeOnAccount(
PolicyHandle, // policy handle
pSid, // SID to grant privilege
L"SeNetworkLogonRight", // Unicode privilege
TRUE // enable the privilege
);


LsaClose(PolicyHandle);

return 0;
}
Как узнать ip адрес(а) машины (в текстовом виде)?

Кусок исходника от плугина к BackOrifice:

void MachineIP(char *result)
{
WSADATA WSAData;

WSAStartup(MAKEWORD(1,1), &WSAData);

char dot[6];
int iResult;
int i = 0;
u_long *ppIpNO;
u_long *pIpNO;
HOSTENT FAR *lphostent;
u_long ipHO;
unsigned char binIp[4];
int iterations = 0;

//Get local host name and crudely validate
char szHostName[100];
*result = 0;

iResult = gethostname(szHostName, sizeof(szHostName));
// printf("%d %s",iResult,szHostName);
if ((iResult != 0) || (lstrcmp(szHostName, "")==0))
return;

//Lok up this host info via supplied name
lphostent = gethostbyname(szHostName);
if (lphostent == NULL)
return;
//Retreive first entry (might have multiple connects)
do
{
iterations++;
ppIpNO = (u_long *)lphostent->h_addr_list;
if (ppIpNO+i == NULL)
return;
pIpNO = ((u_long *)*(ppIpNO+i));
if (pIpNO == NULL)
return;

//convert back to host order, since SOCKADDR_IN expects that
//MessageBox(NULL,"z","x",MB_OK);
ipHO = ntohl(*pIpNO);

binIp[0] = (BYTE)((ipHO &0xff000000) >> 24);
itoa(binIp[0], dot, 10);
strcat(result,dot);
binIp[1] = (BYTE)((ipHO &0x00ff0000) >> 16);
itoa(binIp[1], dot, 10);
strcat(result, "."); strcat(result, dot);
binIp[2] = (BYTE)((ipHO &0x0000ff00) >> 8);
itoa(binIp[2], dot, 10);
strcat(result, "."); strcat(result, dot);
binIp[3] = (BYTE)(ipHO &0x000000ff);
itoa(binIp[3], dot, 10);
strcat(result,"."); strcat(result, dot);
strcat(result,"\r\n");
i++;
} while ((pIpNO != NULL) &&(iterations < 6));
WSACleanup();
PostQuitMessage(0);
return;
}

Материалы находятся на сайте http://cracklab.narod.ru/faq/

Создатель этого HTML файла не претендует на авторство вопросов/ответов представленных в нём, не отвечает за их содержание и достоверность, а также за последствия использования программных кодов , полученных из этого HTML файла. Также не принимаются претензии относительно не размещённой информации об авторе каждого конкретного FAQ'а. Любые другие вопросы присылайте на bad_guy@cracklab.ru (обращаться к Bad_guy'ю).
Hosted by uCoz