Churc

ou também ParamStr(0) abs

Opa Remova soRecurse do StoreOptions e em Zip.AddFiles ao invés de você usar máscara você coloca o nome do arquivo ex Zip.AddFiles('nomearquivo.extensao', 0); abraços

Eita auhahu nesse exemplo que postei ele faz isso... pelo menos aqui faz normal, ai não compacta? Qual versão você utiliza do Abbrevia a última? Fiz o exemplo testei tudo, aqui funcionou normal mesmo você testando o exemplo não compacta?

ahh certo ahuahua eu nem cheguei a ligar, porque se você visse a falta de vontade do UOL em fazer algo nossa, pensei então que se foda. Provavelmente os outros dados devem ser falso também =\ vlw Danilod abraços

acho legal esse esquema, pena que várias pessoas tem má intenções, e já vão querer fazer programinhas pra roubar informações bancárias de outras. Já denunciei vários mas nem os provedores tão ligando tem mais é que se f*** mesmo vo ainda cria um vírus que deleta tudo no PC e com o nome desses provedores rsrs veja um exemplo http://www.server-uol.com.br Esse domínio não é do UOL, e é usado para propagar por email keyloggers que roubam infos bancárias. O método que o cara usa é Email, ele faz um email igualzinho do UOL, só que no do UOL o antivírus é pago, e pelo email dele é gratuito. Ai vai os inocente e baixa, e se fode. O cara sabe que nem vai dar nada pra ele, veja que ele criou .COM.BR onde necessita de CPF ou CNPJ na cara dura. Ai dando um Whois no domínio domínio: server-uol.com.br entidade: JOAO JACINTO NEVES ME documento: 075.134.981/0001-69 responsável: JOAO JACINTO NEVES endereço: RUA INDEPENDENCIA, SN, endereço: 83203-540 - PRAIA DE LESTE - PR telefone: (45) 3265-6598 [] ID entidade: AAS1267 ID admin: AAS1267 ID técnico: AAS1267 ID cobrança: AAS1267 servidor DNS: ns1.hostnet.com.br status DNS: 29/05/2006 AA último AA: 29/05/2006 servidor DNS: ns2.hostnet.com.br status DNS: 29/05/2006 AA último AA: 29/05/2006 criado: 15/05/2006 #2799754 alterado: 25/05/2006 status: publicado ID: AAS1267 nome: Antonio Amaral dos Santos e-mail: java.brazil@gmail.com criado: 25/04/2006 alterado: 17/05/2006 Já pensei em dar um terror ligando pra ele mas se foda se nem o UOL se motivou a fazer algo não vai ser eu rsrs bom foi mal ai sei que nem tem haver com o tópico mas só pra desabafar rsrs também não estou acusando ninguém do tópico só estou comentando... e quem faz esse tipo de coisa parabéns faz mesmo, enche o rabo de dinheiro porque se depender das autoridades você vai ficar rico... só que um dia a casa cai :rolleyes: abraços

consegui rsrs se alguém um dia precisar :rolleyes: ((iFileSize - dwBytesReaded) / (rSpeed * SecsPerDay)); abraços

opa blzz tipo, tava implementando no componente HTTPGet taxa de transferência e Tempo Restante. A taxa de transferência a fórmula seria Tempo que já se passou := ((Hora atual - Hora que começou) * Segundos por dia); Taxa de transferência := (Bytes já baixados / Tempo que já se passou); sendo var dtStartTime: TDateTime; rElapsedSec, rSpeed: Double; dwBytesReaded: DWORD; Quando começa o download dtStartTime := Now; quando está puxando o arquivo rElapsedSec := ((Now - dtStartTime) * SecsPerDay); //SecsPerDay está em SysUtils rSpeed := (dwBytesReaded / rElapsedSec); Até ai funciona, agora, alguém tem alguma noção de como seria a fórmula matemática para se calcular o "Tempo Restante"? :rolleyes: qualquer idéia é bem vinda rsrs abraços

talvez seja porque há várias unidades por produtos, exemplo você tem 300 produtos cadastrados, vamos supor que cada um tenha 5 unidades, 5 unidades X 300 = 1500 neste exemplo serião 1500 etiquetas a serem geradas, o rave mostra algum progresso? Talvez o que você acha que fica gerando páginas infinitas é porque tem vários produtos e varias unidades sendo assim um processo demorado O código não acredito que esteja errado, apesar de não dar pra mim testar mas se alguém viu algum erro posta ai... abraços

opa tente isso Zip.StoreOptions := [soStripDrive, soRemoveDots, soRecurse]; em StoreOptions se tiver soStripPath, ele não cria pastas dentro do Zip se precisar e eu puder ajudar pode contar comigo ;) abraços

opa tente o seguinte, Zip.StoreOptions := Zip.StoreOptions + [soRecurse]; //soRecurse faz com que seja adicionado todos os arquivos, pastas e subpastas no diretorio que você quer compactar Zip.BaseDirectory := IncludeTrailingPathDelimiter(EdtOrigem.Text); //BaseDirectory é o diretório que você quer compactar Zip.FileName := 'Caminho e nome do arquivo .zip a ser salvo'; //Ai você coloca o caminho e nome do arquivo a ser salvo, exemplo, backup.zip Zip.AddFiles('*.*', 0); Zip.Save; Zip.CloseArchive; se der algum erro, tente fazer o CloseArchive e depois o Save... acho mais provável ser isso, pois salvar algo pra depois fechá-lo talvez de pau rsrs abraços

opa tente isso, procedure TFrmEtiquetas.RvSystem1Print(Sender: TObject); Var Factor : Double; CurLabel : Integer; CurCol : Double; CurRow : Double; MarginTop : Double; MarginLeft : Double; LabelRow : Integer; LabelRows : Integer; LabelCols : Integer; LabelWidth : Double; LabelHeight : Double; V : Real; iCount,iUnidades : Integer; begin //--------------------------------------------------------------------------- // Configurações externas do formulario de Etiquetas //--------------------------------------------------------------------------- MarginLeft := StrToFloat(Edit1.Text);// Margem esquerda para impressao da primeira etiqueta MarginTop := StrToFloat(Edit2.Text);// Margem superior para impressao da primeira etiqueta LabelWidth := StrToFloat(Edit3.Text);// Largura da Etiqueta LabelHeight := StrToFloat(Edit4.Text);// Altura da Etiqueta LabelRows := StrToInt(Edit5.Text); // Numero de linhas de etiquetas LabelCols := StrToInt(Edit6.Text); // Numero de colunas de etiquetas //--------------------------------------------------------------------------- CurLabel := 0; // Retorna o numero da etiqueta que está sendo impressa LabelRow := 0; // Retorna o numero atual da linha de etiquetas em impressao ADOQuery1.Close; ADOQuery1.SQL.Text := 'SELECT * FROM PRODUTOS'; ADOQuery1.Open; RVSystem1.BaseReport.SetFont('Arial',8); While not ADOQuery1.Eof do begin iUnidades := ADOQuery1.FieldbyName('Qde').AsInteger; V:= ADOQuery1.FieldByName('VALOR').AsFloat; for iCount := 1 to iUnidades do begin Factor := (CurLabel Mod LabelCols); // um pequeno artificio matematico pra calcular CurCol := (Factor*LabelWidth)+MarginLeft; // a posicao de cada etiqueta dinamicamente. CurRow := (LabelRow * LabelHeight) + MarginTop; RVSystem1.BaseReport.GotoXY(CurCol,CurRow); // Imprime na posicao calculada acima RVSystem1.BaseReport.Bold := False; RVSystem1.BaseReport.PrintLeft( ADOQuery1.FieldByName('PRODUTO').AsString,CurCol); RVSystem1.BaseReport.NewLine; RVSystem1.BaseReport.Bold := True; RVSystem1.BaseReport.PrintLeft('R$ ' + Formatfloat('###,###,##0.00', V), CurCol);;RVSystem1.BaseReport.NewLine; RVSystem1.BaseReport.Bold := False; RVSystem1.BaseReport.PrintLeft( ADOQuery1.FieldByName('FORNECEDOR').AsString,CurCol); RVSystem1.BaseReport.NewLine; RVSystem1.BaseReport.PrintLeft( 'NUMERO: '+Format('%0.5d',[Curlabel]),CurCol); RVSystem1.BaseReport.NewLine; Inc(CurLabel); //TROCA DE LINHA DE ETIQUETA // Se preencheu uma linha de etiquetas, reposiciona na margem e calcula a posicao da proxima etiqueta If Factor=LabelCols-1 Then Inc(LabelRow); // TROCA DE PAGINA // Se preencheu uma pagina de etiquetas, reinicializa a impressao If LabelRow>=LabelRows Then Begin LabelRow := 0; RVSystem1.BaseReport.NewPage; end; end; ADOQuery1.Next; end; end; ixe nem tem como eu testar no delphi, qlq coisa posta ai abraços

tente AbZipper1.BaseDirectory := 'C:\Meu sistema\dados\'; AbZipper1.AddFiles('*.*', 0); AbZipper1.CloseArchive; abraços

opa cola o codigo aqui pra ver onde está o erro abraços

RegisterHotKey(Handle, HKeySet, MOD_CONTROL, Ord('A')); troque o A pela letra que você quiser ou uma variável que armazene a letra desejada bjos

RegisterHotKey(Handle, HKeySet, 0, $46); mas não acho conveniente, até porque já penso a pessoa está digitando um texto e seu programa aparecendo na frente rsrs

uses Messages; Declare em Public public procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY; end; declare uma variavel global var HKeySet: Integer; implementation procedure TNomedoForm.WMHotKey(var Msg: TWMHotKey); begin if (Msg.HotKey = HKeySet) then Show; end; No OnFormCreate você registra a hotkey HKeySet := GlobalAddAtom('Hotkey1'); RegisterHotKey(Handle, HKeySet, MOD_CONTROL, $46); $46 ou 70 pra letra F e no OnClose você desregistra, não necessário mas recomendável UnregisterHotKey(Handle, HKeySet); bjos

Boa explicação Micheus ;) exatamente, CVS, utilizado por vários programas como pra exportar contatos do outlook uhahua Eder, está correto sim, da forma em que você estava fazendo, não havia definição do tamanho do campo, por isso saia tudo embaralhado exemplo vou pegar uma linha conforme você passou: 00003CARLOSTIMBOSC Separando, e pegando a index de cada caracter * 0 0 0 0 3 C A R L O S T I M B O S C 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 ai você fez Table1.FieldByName('Codigo').Value := Copy(Entrada, 1, 5); Perfeito, porque você sabe que o campo "Código" tem 5 caracteres, então você pegou do 1 ao 5, só não precisa do 0 Ficando 0 0 0 0 3 1 2 3 4 5 Agora vem o problema, a linha salva no texto não indica de nenhum modo onde começa e onde termina o nome, e como nome não existe um número de caracteres exatos, então como você vai saber no meio de um monte de letras o nome de uma pessoa? Table1.FieldByName('Nome').Value := Copy(Entrada,6,20); ficando * 0 0 0 0 3 C A R L O S T I M B O S C 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Então usando delimitadores de campos, você extrai por completo cada valor que você queira, independente do seu tamanho... entendeu mais ou menos? huauah * o script não mostra do jeito que fiz, ele faz com que 2 espaços fique igual a 1 =\ abraços

tipo, procedure TForm1.Button3Click(Sender: TObject); Var F: TextFile; begin AssignFile(F,'Clientes.txt'); Rewrite(F); Table1.First; While not Table1.Eof do begin Writeln(F,Table1.FieldByName('Codigo').Value + PathSep + Table1.FieldByname('Nome').Value + PathSep + Table1.FieldByname('Cidade').Value + PathSep + Table1.FieldByname('uf').Value); Table1.Next; end; CloseFile(F); Button2.Enabled := True; Button3.Enabled := False; end; ficaria tipo 00001;JOSE;BRUSQUE;SC 00002;MARIA;INDAIAL;SC 00003;CARLOS;TIMBO;SC ai pra ler procedure TForm1.Button2Click(Sender: TObject); var Txt : TextFile; Entrada : String; begin Assignfile(Txt,'Clientes.Txt'); Reset(Txt); While not Eoln(Txt) do begin Readln(Txt,Entrada); Table1.Insert; Table1.FieldByName('Codigo').Value := Copy(Entrada,1,Pos(PathSep, Entrada) - 1); Delete(Entrada, 1, Pos(PathSep, Entrada)); Table1.FieldByName('Nome').Value := Copy(Entrada,1, Pos(PathSep, Entrada) - 1); Delete(Entrada, 1, Pos(PathSep, Entrada)); Table1.FieldByName('Cidade').Value := Copy(Entrada, 1, Pos(PathSep, Entrada) - 1); Delete(Entrada, 1, Pos(PathSep, Entrada)); Table1.FieldByName('UF').Value := Copy(Entrada, 1, Length(Entrada)); Table1.Post; end; CloseFile(Txt); Button3.Enabled := True; end; PathSep é uma constante definida em SysUtils, onde você pode substituir por qualquer caracter que não esteja em nenhum campo do banco de dados. exemplo &, #, § qualquer coisa posta ai que não testei no delphi abraços

pego em algum lugar que não lembro aonde Function Extenso(xValor: Double;xSingular,xPlural: String): String; Function IFN(vCond:Boolean; rTrue,rFalse:LongInt):LongInt; Begin If vCond=True Then IFN := rTrue Else IFN := rFalse; End; function ReplaceStr(const S, OldPattern, NewPattern: string; ReplaceAll:Boolean=True; IgnoreCase:Boolean=True): string; var SearchStr, Patt, NewStr: string; Offset: Integer; begin if IgnoreCase then begin SearchStr := AnsiUpperCase(S); Patt := AnsiUpperCase(OldPattern); end else begin SearchStr := S; Patt := OldPattern; end; NewStr := S; Result := ''; while SearchStr <> '' do begin Offset := AnsiPos(Patt, SearchStr); if Offset = 0 then begin Result := Result + NewStr; Break; end; Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern; NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt); if not ReplaceAll then begin Result := Result + NewStr; Break; end; SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt); end; end; Function StrZero(xVal:LongInt;xTam:Integer):String; Var xRet : String; Begin xVal := Abs(xVal); Str(xVal,xRet); While Length(xRet) < xTam do Insert('0',xRet,1); StrZero := xRet; // Exemplo mais simples: StrZero := Format('%0.'+IntToStr(xTam)+'d',[xVal]); End; Function IFS(vCond:Boolean; rTrue,rFalse:String):String; Begin If vCond Then Result := rTrue Else Result := rFalse; End; Function ExtCem(xCem:String):String; Var Aval : Array [1..3] Of Integer; xRet : String; Const Acent : Array[1..9] of String = ('Cento', 'Duzentos', 'Trezentos', 'Quatrocentos','Quinhentos', 'Seiscentos', 'Setecentos','Oitocentos', 'Novecentos'); Avint : Array[1..9] of String = ('Onze', 'Doze', 'Treze', 'Quatorze', 'Quinze','Dezesseis', 'Dezessete', 'Dezoito', 'Dezenove'); Adez : Array[1..9] of String = ('Dez', 'Vinte', 'Trinta', 'Quarenta', 'Cinquenta','Sessenta', 'Setenta', 'Oitenta', 'Noventa'); Aunit : Array[1..9] of String = ('Um', 'Dois', 'Três', 'Quatro', 'Cinco', 'Seis','Sete', 'Oito', 'Nove'); Begin xRet := ''; Aval[1] := StrToInt(xCem[1]); Aval[2] := StrToInt(xCem[2]); Aval[3] := StrToInt(xCem[3]); if StrToInt(xCem)>0 Then Begin if StrToInt(xCem) = 100 Then Begin xRet := 'Cem '; End else Begin if Aval[1] >0 Then Begin xRet := Acent[Aval[1]] + IFS( ( Aval[2] + Aval[3] > 0 ), ' e', '' ); end; if ( Aval[2] = 1 ) and ( Aval[3] > 0 ) Then Begin xRet := xRet + ' ' + Avint[ Aval[3] ] + ' '; End else Begin if Aval[2]>0 Then Begin xRet := xRet + ' ' + Adez[ Aval[2] ] + IFS( Aval[3] > 0, ' e', '' ); end; xRet := xRet + IFS(Aval[3] > 0, ' '+ Aunit[ Aval[ 3 ] ],''); end; end; end; ExtCem := xRet; End; Var Tstr : String; xCifra : Array [1..6,1..2] of String; Tx : Integer; xExt : String; Tsubs : String; xCent : Integer; Begin xExt := ''; TSubs := ''; Tstr := FormatFloat('0000000000000000.00',xValor); xCent := StrToInt(Copy(Tstr,18,2)); Tstr := Copy(Tstr,1,16); xValor:= StrToInt(Tstr); xCifra[1,1] := 'Trilhão'; xCifra[1,2] := 'Trilhões'; xCifra[2,1] := 'Bilhão'; xCifra[2,2] := 'Bilhões'; xCifra[3,1] := 'Milhão'; xCifra[3,2] := 'Milhões'; xCifra[4,1] := 'Mil'; xCifra[4,2] := 'Mil'; xCifra[5,1] := ' '; xCifra[5,2] := ' '; xCifra[6,1] := 'Centavo'; xCifra[6,2] := 'Centavos'; if xValor+xCent>0 Then Begin if xCent>0 Then Begin xExt := ExtCem( strzero( xCent, 3 ) ) + ' '+xCifra[6][ IFN( xCent = 1, 1, 2 ) ]; end; if int(xValor)>0 Then Begin xExt := IFS( int(xValor)=1,' '+xSingular,' '+xPlural)+IFS( xCent > 0, ' e ','' ) + xExt; end; for Tx := 5 Downto 1 Do Begin Tsubs := Copy(Tstr,(Tx*3)-1,3); if StrToInt(Tsubs) > 0 Then Begin xExt := ExtCem(Tsubs)+#32+xCifra[Tx,IFN(StrToInt(Tsubs)=1,1,2)]+' '+ xExt; end; End; End; xExt := Trim(xExt); Repeat xExt := ReplaceStr(xExt,#32#32,#32); Until Pos(#32#32,xExt)=0; Extenso := xExt; End; Function ExtensoReal(xValor: Double): String; Begin Result := Extenso(xValor,'Real','Reais'); End; ai você usa exemplo Label1.Caption := Extensoreal(valor); abraços

só ler o manual que vem junto com o componente (Abbrevia.pdf) :)

opa coloca isso antes do Add AbZipper.StoreOptions := AbZipper.StoreOptions + [soStripDrive, soStripPath]; acho que é isso... abraços

pode-se usar o InttoStr ShowMessage(InttoStr()); abraços

como assim não consegue extrair o conteudo? o que você quer fazer..!? da um exemplo, ou algo parecido ;) abraços

ouu então, como eu falei num post acima, eu não manjo mexer com rave, alias nunca mexi auhehua não mexo com bd também, mas pela lógica seria algo assim RvSystem1Print aqui é onde imprime as etiquetas certo e você da um ADOQuery1.Next; pra ir pra próxima então o que você tem a fazer é, armazenar em uma variável a quantidade de unidades desse produto, e fazer um loop antes de dar o ADOQuery1.Next; exemplo var iCount, iUnidades: Integer; begin ...... ... ... iUnidades := ADOQuery1.FieldByName('XXX').AsInteger; onde XXX é o nome do campo que armazena a quantidade for iCount := 1 to iUnidades do begin ....aqui vai todo o codigo de impressão da etiqueta sendo assim, sera impresso a quantidade de etiquetas do produto atual end; //End loop e só aqui você da um next ADOQuery1.Next; end; o ADOQuery1.Next; tem que estar fora do Loop entendeu mais ou menos rsrs? só não sei se vai dar certo, mas pela lógica... abraços

opa beleza amigo, que Deus lhe abençoe também e boa sorte ai ;) abraços